{This sample program is a menu driven  demo program for the Pascal Utilities 2.1
 It demostrates background music, pie, bar, line charts and animation.
 It can also be used to test individual routines with  user supplied
 parameters.
(C)Copyright Software Labs. 1052 Lily Ave. Sunnyvale, CA 94086. (408)-241-9539.}
{ demog - a pascal unit to demostrate graphics and music }
{ demos - a pascal unit to display all the text color table }
{$include:'b:demog.inc'}
{$include:'b:demos.inc'}
program demo( input, output );
uses demogunit( demog );
uses demosunit( demosall, demos );

{The following include files contains the declarations for external functions
 which are written in 8088 Macro Assembly Language.}
{$include:'b:slib.inc'}      {Screen control routines }
{$include:'b:glib.inc'}      {Graphics routines }
{$include:'b:alib.inc'}      {Animation routines }
{$include:'b:plib.inc'}      {Music and periperal control routines }
{$debug-}
procedure time( var s: string ); extern;   { IBM PASCAL function }

const
 msgcol = 0; msgrow =23;	 { col & row for displaying prompt message }
 inforow = 22;		    { row number for displaying returned information}
 displayrow = 0;				    { display time and mode }
 softsize = 10; 	      { number of characters displayed in a softkey }
 { attribute for the IBM monochrome screen display  }
 normal = 2; intensity = 15; reverse=120;
 blinking = 128+normal	;  rblink = reverse+128;	 { reverse blinking }
 lastmode = 8;

 { scan code for characters}
 scanf0 = 58; scanf10 = scanf0+10;	     { scan code for F1 - 1 and F10 }
 qesc = 1; {ESC exit }

 homecol = 33; homerow = 13;				{ home row & column }

 { constant for display softkeys }
 keyrow = 1; keyrowdiff =  2; keysecondcol =11; keystartcol = 0;
 blanks = '                                        ';
 initialdelay = 300;		{initial delay }

type
  softkeytype = array[ 1 .. 10 ] of lstring(softsize);{ labels for 10 softkeys}
  timetype = string(8); 		{ for calling the time function }

var
  modes[static] : softkeytype;		   { message for screen mode 0 to 7 }
  rcolor[static] : array[0..7] of integer; { blinking color for screen modes}
  rbcolor[static] : array[0..7] of integer; {reverse blinking for screen modes}
  displayedtime : timetype;		   { displayed time on the screen }
  currentrow, currentcol, currentpage, currentstart, currentstop, currentmode,
  lastscan : integer;
  lastch : char;

value
  { modes  - used as the prompt message when the user wants to execute
	     screen or screeng procedure.
    rcolor - used to display reverse video message for different screen modes.
    rbcolor- used to display rever and blinking message for screen modes. }
  modes[ 1 ] := '0:40x25 BW';  rcolor[ 0 ] := reverse;  rbcolor[ 0 ] := rblink;
  modes[ 2 ] := '1:40x25 C ';  rcolor[ 1 ] := reverse;  rbcolor[ 1 ] := rblink;
  modes[ 3 ] := '2:80x25 BW';  rcolor[ 2 ] := reverse;  rbcolor[ 2 ] := rblink;
  modes[ 4 ] := '3:80x25 C ';  rcolor[ 3 ] := reverse;  rbcolor[ 3 ] := rblink;
  modes[ 5 ] := '4:320x200C';  rcolor[ 4 ] := normal;   rbcolor[ 4 ] := 1;
  modes[ 6 ] := '5:320x200B';  rcolor[ 5 ] := normal;   rbcolor[ 5 ] := 1;
  modes[ 7 ] := '6:640x200B';  rcolor[ 6 ] := normal;   rbcolor[ 6 ] := 1;
  modes[ 8 ] := '7:80x25 BW';  rcolor[ 7 ] := reverse;  rbcolor[ 7 ] := rblink;




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




{*****copyright -  print copyright message }
procedure copyright;
begin
 lstringwrite(currentpage, 24, 6, intensity,'(C) Copyright Software Labs 1983');
end; {copyright}



{*****pressreturn - wait until any key is pressed }
procedure pressreturn;
begin
  lstringwrite(currentpage,msgrow, msgcol, intensity, 'Press any key to exit');
  while not inkey( lastch, lastscan ) do { do nothing } ;
end; { pressreturn }




{*****pressclear - wait until any key is pressed then clear the screen }
procedure pressclear;
begin
  pressreturn;
  screen ( currentmode);      { clear the screen }
end; { pressreturn }




{****** blankmessage - blank the message line and the information line }
procedure blankmessage;
begin
  lstringwrite(currentpage,msgrow,msgcol,normal,blanks);
  lstringwrite(currentpage,inforow,msgcol,normal,blanks);
  locate(currentpage, currentrow, currentcol);
end; { blankmessage }




{***** arraymessage - display messages in array format (2 columns) }
{ the left column start from column: startcolumn; right column from secondcol}
procedure arraymessage(const msg : softkeytype; last, page, startrow,
	startcol, secondcol, rowdiff,  attribute : integer);
var
  row, i : integer;
begin
  i := 1;  row := startrow;
  while i < last do begin
    locate(page, row, startcol);
    putlstring(page,  attribute, msg[i] );	      { left column message}
    i := i +1;
    if i > last then break			      { out of loop }
    else begin
      locate(page, row, secondcol);
      putlstring( page, attribute, msg[i] );	       {right column message}
      row := row + rowdiff;
      i := i +1
    end;
  end;
end; { arraymessage }




{***** displaytime - display current time on the top line }
{ The time interval between displaytime is very short, the redisplaying line
  on the screen is flashing. To avoid that, we will redisplay time only if
  it is different from the previously  displayed time}
 procedure displaytime;
 var
   currenttime : timetype;
 begin
  time( currenttime );
  if currenttime <> displayedtime then	  { displayedtime is a global	      }
  begin 				  {variable storing the displayed time}
     locate(currentpage, displayrow, 0);
     putstring(currentpage, normal, 8, currenttime);
     locate( currentpage, currentrow, currentcol);
     movel(adr currenttime[1], adr displayedtime[1], 8);  {update displayedtime}
  end;
end; { displaytime }




{***** displaymode - display screen mode on the right most of the top line }
procedure displaymode;
var key : integer;
begin
  locate(currentpage, displayrow, 39);
  putchar( currentpage, normal, 1, chr(currentmode+ord('0')) );
end; { displaymode }




{****** concatvalue- attach an integer value to an lstring }
procedure concatvalue( var ls : lstring; dvalue, size : integer);
var
  svalue : lstring(10);
begin
  eval( encode( svalue, dvalue:size));	{ convert dvalue into lstring(svalue)}
  concat( ls, svalue);
end; { concatvalue }




{***** displaycursor - display cursor information }
{ prepare a printing buffer for the cursor with the following information: }
{ (page,row,col) [start..stop]			     }
procedure displaycursor;
var
  ls : lstring(80);
begin
  ls := ' (';
  concatvalue(ls, currentpage, 1);  concat(ls, ',');              { page   }
  concatvalue(ls, currentrow  ,2);  concat(ls, ',');              { row    }
  concatvalue(ls, currentcol  ,2);  concat(ls, ') [');            { column }
  concatvalue(ls, currentstart,2);  concat(ls, '..');             { start  }
  concatvalue(ls, currentstop ,3);  concat(ls, '] ');             { stop   }
  lstringwrite(currentpage,  displayrow, 8, normal, ls);
end; { displaycursor }




{***** displaych - display the last character }
{ prepare a printing buffer for the character with the following format }
{ ord: chr : scan }
procedure displaych;
var  string1 : string(1);
  ls : lstring(80);
begin
  ls := ' ';
  string1[1] :=  lastch;
  concat(ls, string1);	       concat(ls, ':');
  concatvalue(ls, ord(lastch),3);   concat(ls, ':');
  concatvalue(ls, lastscan,3);
  lstringwrite(currentpage, displayrow, 28,  normal, ls);
end; { displaych }




{***** messageuse - displaying a message on the screen }
procedure messageuse;
begin
  lstringwrite(currentpage, msgrow, msgcol,  intensity,
	'Press F1..F10 (selction) or ESC (exit)  ');
  locate(currentpage, currentrow, currentcol);
end; { messageuse }




{***** newdisplay - display 10 softkeys, and the current time }
procedure newdisplay(const message: softkeytype);
var
  numcolumn : integer;
begin
  currentmode := screenmode( currentpage, numcolumn);
  screen(currentmode);
  copyright;
  arraymessage( message, softsize, currentpage, keyrow, keystartcol,
	keysecondcol, keyrowdiff, rcolor[currentmode]);
  messageuse;			       { 'use function keys' message }
  displaytime;
end; { newdisplay }




{***** blinkkey - blink the position of the pressed function key }
procedure blinkkey( msg : softkeytype; key : integer; var blinkrow,
	blinkcol : integer);
begin
  { find the location (row, left or right column)  of the pressed key }
  blinkrow := keyrow + ((key-1) div 2 ) * keyrowdiff;
  if ( key mod 2 ) = 1 then
    blinkcol := keystartcol
  else
    blinkcol := keysecondcol;
  lstringwrite(currentpage, blinkrow, blinkcol, rbcolor[currentmode],
       msg[key]);
end; { blinkkey }




{***** cursormoves - routines responsed for moving the cursor }
procedure cursormoves( scan : integer );
const
 qhome = 71;	{ home }
 qup   = 72;	{ up arrow in the number pad }
 qleft = 75;  qright= 77; qdown = 80;
begin
  case scan of
   qup	 : currentrow := currentrow-1;
   qdown : currentrow := currentrow+1;
   qleft : currentcol := currentcol -1;
   qright: currentcol := currentcol + 1;
   qhome : begin  currentrow := homerow; currentcol := homecol; end;
   otherwise { do nothing }
  end;
  locate( currentpage, currentrow, currentcol);
  readcursor(currentpage, currentrow, currentcol, currentstart, currentstop);
  displaycursor;
  locate( currentpage, currentrow, currentcol);
end; { cursormoves }




{***** getint - ask the user to type an integer from the keyboard }
function getint( const msg : lstring ): integer;
label 1;
var
  msgbuffer,ls : lstring(80); i : integer;
begin
  { print the prompt message }
  msgbuffer := 'Enter > ';
  insert(msg, msgbuffer, 7);		  { IBM routines to insert msg into
				       msgbuffer just befor the 7th character}
1:lstringwrite(currentpage, msgrow, msgcol, intensity, msgbuffer);
  readln(ls);
  if ord(ls[0]) = 0 then	  { carrige return returns zero length string }
    getint := 0
  else
    if decode( ls, i ) then	       { convert ls into an integer sucessful}
      getint := i
    else begin					     { decode failed }
      lstringwrite(currentpage, msgrow, msgcol, normal, blanks); { erase it }
      goto 1;					    { ask again  }
    end;
  lstringwrite(currentpage, msgrow, msgcol, normal, blanks); { erase it }
end; { getint }




{***** getstring - get a string }
procedure getstring(const msg : lstring; var ls : lstring);
var  msgbuffer : lstring(80);
begin
  msgbuffer := 'Enter > ';
  insert(msg, msgbuffer, 7);				   { IBM routine }
  lstringwrite(currentpage, msgrow, msgcol, intensity, msgbuffer);
  readln(ls);
  lstringwrite(currentpage, msgrow, msgcol, normal, blanks);   { erase it }
end; {getstring}




{***** askpage - ask the user to type the page number from the keyboard}
function askpage : integer;
begin
  if currentmode >=  4 then
    askpage := getint('page(0..0)')
  else if currentmode >= 2 then
    askpage := getint('page(0..3)')
    else
      askpage := getint('page(0..7)');
end; {askpage}




{***** screen1routines - routines for handling screen routines }
procedure screen1routines;
const
 { screen keys }
  qscreen    = 1;	 qputchar   = 2;
  qreadcursor= 3;	 qputstring = 4;
  qlocate    = 5;	 qputlstring= 6;
  qscroll    = 7;	 qscreenchar= 8;
  qselectpage= 9;	 qexit	    =10;

var
  ls : lstring(80);  page, color, i, scancode,ulrow, lrcol,lrrow,
  blinkcol, blinkrow, column, mode, key : integer;
  screen1 [static] : softkeytype;   ch : char;

value
  screen1[ qscreen    ] := 'SCREEN    ';  screen1[ qputchar   ] := 'PUTCHAR   ';
  screen1[ qreadcursor] := 'READCURSOR';  screen1[ qputstring ] := 'PUTSTRING ';
  screen1[ qlocate    ] := 'LOCATE    ';  screen1[ qputlstring] := 'PUTLSTRING';
  screen1[ qscroll    ] := 'SCROLL    ';  screen1[ qscreenchar] := 'SCREENCHAR';
  screen1[ qselectpage] := 'SELECTPAGE';  screen1[ qexit      ] := 'EXIT      ';

begin
  newdisplay( screen1 );	    { display softkey on the screen }
  displaycursor;		    { cursor position and shape }
  displaych;			    { last pressed character	}
  displaymode;			    { screen mode }
  messageuse;
  repeat			    { until the user pressed ESC }
   while not inkey( lastch, lastscan ) do { while no key is pressed }
     displaytime;		    { update the displayed time on the screen}
   displaych;
   if lastscan = qesc then break;	{ exit }
   if lastscan = scanf10 then break;
   if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
     key := lastscan - scanf0;
     blinkkey(screen1, key, blinkrow, blinkcol );   { blinking the pressed key}
     blankmessage;				    { blank message lines }
     case key  of
      qscreen :
	     begin
		if currentmode = 7 then
		  mode := getint('mode (7..7)')
		else begin
		  { print screen information by using the modes array}
		  arraymessage(modes,7,currentpage,17,2,15,1,normal);
		  mode := getint('mode (0..6)')
		end;
		  { the seting to mode 7 for non Monochrome adapter will have
		     snow flashing }
		if ( mode = 7 ) and ( currentmode <> 7 ) then begin
		  lstringwrite(currentpage,msgrow, msgcol, normal,
		' Only Monochrome and Parallel Printer Adapter can use Mode 7');
		  pressreturn;
		end
		else begin
		  screen( mode );
		  currentmode := screenmode( currentpage, column);
		  newdisplay( screen1 );
		end;
	      end;

      qscreenchar : begin
		page := askpage;
		locate(page, currentrow, currentcol);
		ch := screenchar(page, color);
		locate(currentpage, inforow, msgcol);
		writeln('SCREENCHAR=',ch  ,' attribute=',color:1,
			' ord(SCREENCHAR)=', ord(ch):1);
	      end;

      qputchar : begin
		page := askpage;
		color := getint('color (0..255)');
		{ if the user type ENTER, or carriage return, then ask for
		  the scan code input }
		getstring('character(ENTER for scan code)',ls);
		if ls[0] = chr(0) then begin	  { ENTER }
		  { scan code input }
		  repeat
		    scancode := getint('scan code (0..255)');
		  until ( scancode >= 0 ) and ( scancode <= 255);
		  ch := chr( scancode );
		end
		else
		  ch := ls[1];
		i := getint('count');
		locate(page, currentrow, currentcol);
		putchar(page,color,i,ch);
		readcursor(currentpage, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
	      end; { qputchar }

      qputstring : begin
		page := askpage;
		color := getint('color (0..255)');
		getstring('string',ls);
		i := getint('length');
		locate(page, currentrow, currentcol);
		putstring(page, color, i, ls[1]);
		readcursor(currentpage, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
	      end;

      qputlstring : begin
		page := askpage;
		color := getint('color (0..255)');
		getstring('string',ls);
		locate(page, currentrow, currentcol );
		putlstring(page, color, ls);
		readcursor(currentpage, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
	      end;

      qselectpage : begin
		page := askpage;
		selectpage(currentpage);
		newdisplay( screen1);
	      end;

      qscroll : begin
		getstring('Up/Down',ls);
		i := getint('numline(0..24), 0:entire window');
		ulrow  := getint('ulrow');
		column := getint('ulcol');
		lrrow  := getint('lrrow');
		lrcol  := getint('lrcol');
		color  := getint('background color');
		scroll(ls[1], i, ulrow, column, lrrow, lrcol, color);
	      end;

      qreadcursor  : begin
		page := askpage;
		locate(page, currentrow, currentcol );
		readcursor(page, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
		locate(currentpage, inforow, msgcol);
		writeln('row=',currentrow:1, ' col=', currentcol:1,' start=',
			currentstart:1, ' stop=',currentstop:1);
	      end;

      qlocate : begin
		page := askpage;
		lrrow  := getint('row number (0..24)');
		mode := screenmode(currentpage, column);
		if column = 80 then
		  lrcol  := getint('column number (0..79)')
		else
		  lrcol  := getint('column number (0..39)');
		locate(page, lrrow, lrcol);
		readcursor(currentpage, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
	      end;


      otherwise { do nothing }
      end; { case }
     lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
	 , screen1[key]);      { reset the blinking function key to reverse }
     lstringwrite(currentpage,msgrow,msgcol,normal,blanks);
     messageuse;
     end  { if lastscan > scanf0 and lastscan <= scanf10 }
    else
      cursormoves( lastscan );
   until false; 	{ repeat until ESC is pressed }
end; {screen1routines}




{***** screen2routines - routines for handling screen routines }
procedure screen2routines;
const
 { screen keys }
  qmono      = 1;	 qnewcursor = 2;
  qmonitorc  = 3;	 qreadcursor= 4;
  qborder    = 5;	 qscreenmode= 6;
  qinkey     = 7;	 qexit	    = 10;

 var
  page, row, col, x, y, blinkcol, blinkrow, numcolumn, key, color : integer;
  screen2 [static] : softkeytype;

value
  screen2[ qmono      ] := 'MONO      ';  screen2[ qnewcursor ] := 'NEWCURSOR ';
  screen2[ qmonitorc  ] := 'MONITORC  ';  screen2[ qreadcursor] := 'READCURSOR';
  screen2[ qborder    ] := 'BORDER    ';  screen2[ qscreenmode] := 'SCREENMODE';
  screen2[ qinkey     ] := 'INKEY     ';  screen2[ 8          ] := '          ';
  screen2[ 9	      ] := '          ';  screen2[ qexit      ] := 'EXIT      ';

 begin
  newdisplay( screen2 );	    { display softkey on the screen }
  displaycursor;		    { cursor position and shape }
  displaych;			    { last pressed character	}
  displaymode;			    { screen mode }
  messageuse;
  repeat			    { until the user pressed ESC }
   while not inkey( lastch, lastscan ) do   { while no key is pressed }
     displaytime;		    { update time display }
   displaych;
   if lastscan = qesc then break;	{ exit }
   if lastscan = scanf10 then break;
   if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
     key := lastscan - scanf0;
     blinkkey(screen2, key, blinkrow, blinkcol );   { blinking the pressed key}
     blankmessage;				    { blank message lines }
     case key  of
      qmono   : begin
		mono;	       { switch to the mono monitor }
		currentmode := screenmode( currentpage, numcolumn);
		newdisplay( screen2);
	      end;

      qmonitorc:  begin
		monitorc;	 { switch to the color monitor }
		currentmode := screenmode( currentpage, numcolumn);
		newdisplay( screen2 );
	      end;

      qreadcursor  : begin
		page := askpage;
		locate(currentpage, currentrow, currentcol);
		readcursor(page, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
		locate(currentpage, inforow, msgcol);
		writeln('row=',currentrow:1, ' col=', currentcol:1,' start=',
			currentstart:1, ' stop=',currentstop:1);
	      end;

      qnewcursor  : begin
		currentstart  := getint('start line(0..32)32:invisible');
		currentstop   := getint('stop line(0..31)');
		locate(currentpage, currentrow, currentcol);
		newcursor( currentstart, currentstop);
		readcursor(currentpage, currentrow, currentcol, currentstart,
			currentstop);		 { update the cursor position}
		displaycursor;
	      end;

      qscreenmode : begin
		currentmode := screenmode( currentpage, numcolumn);
		locate(currentpage, inforow, msgcol);
		writeln('SCREENMODE=',currentmode:1, ' page=', currentpage:1,
			' numcolumn=', numcolumn:1);
	      end;

      qinkey : begin
		lstringwrite(currentpage, msgrow, msgcol,normal,
			'Press any key to continue');
		while not inkey( lastch, lastscan ) do{ while no key is pressed}
		  displaytime;			 { update time display }
		displaych;
		locate(currentpage, inforow, msgcol);
		writeln('INKEY=TRUE ch=', lastch,' scan=',lastscan:1,' ord(ch)=',
				ord(lastch):1);
	      end;

      qborder : begin
		color := getint('border color (0..31)');
		border( color);
	      end;

      otherwise { do nothing }
      end; { case }
     lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
	 , screen2[key]);      { reset the blinking function key to reverse }
     lstringwrite(currentpage,msgrow,msgcol,normal,blanks);
     messageuse;
     end  { if lastscan > scanf0 and lastscan <= scanf10 }
    else
      cursormoves( lastscan );
   until false; 	{ repeat until ESC is pressed }
end; {screen2routines}





{***** graphicsroutines - handle graphics routines }
procedure graphicsroutines;
const
 { graphics keys }
  qpalette    = 1;   qpaint    = 2;
  qreaddot    = 3;   qgetpic   = 4;
  qwritedot   = 5;   qputpic   = 6;
  qdrawline   = 7;   qview     = 8;
  qcircle     = 9;   qlightpen =10;
  picsize = 260;      { for getpic & putpic }

var
  blinkcol, blinkrow,sangle, eangle, width, height, x2, y2, mode, page, numcolumn,
  i, x, y, col, row, bcolor, fcolor, action, palettenum, key : integer;
  pic : string(picsize);     {storing picture for getpic and putpic }
  graphics [static] : softkeytype;

value
  graphics[ qpalette   ] := 'PALETTE   ';
  graphics[ qreaddot   ] := 'READDOT   ';
  graphics[ qwritedot  ] := 'WRITEDOT  ';
  graphics[ qdrawline  ] := 'DRAWLINE  ';
  graphics[ qcircle    ] := 'CIRCLE    ';
  graphics[ qgetpic    ] := 'GETPIC    ';
  graphics[ qputpic    ] := 'PUTPIC    ';
  graphics[ qpaint     ] := 'PAINT     ';
  graphics[ qview      ] := 'VIEW      ';
  graphics[ qlightpen  ] := 'LIGHTPEN  ';



   {***** askcolor - ask color from the user depending the palette number}
   function askcolor:integer;
   begin
       if palettenum = 0 then
	 askcolor := getint('color (1:G;2:R;3:Y)')
       else
	 askcolor := getint('color (1:C;2:M;3:W)');
   end;  {askcolor}



   {***** askx - ask x-coordinate from the user depending on the mode }
    function askx : integer;
    begin
       if currentmode = 6 then
	 askx := getint('x coordinate (0..639)')
       else
	 askx := getint('x coordinate (0..319)');
    end;  {askx}



begin
  { change it to graphics mode 4 if possible }
  currentmode := screenmode(page, numcolumn);
  if ( currentmode = 7 ) then begin	  { monochrome card }
    lstringwrite(currentpage, inforow,msgcol, normal,
	' There is no Color/Graphics Adapter');
    pressclear;
  end
  else
    if currentmode <> 4 then begin
      screen(currentmode);
      lstringwrite(currentpage, inforow, msgcol, normal,
	 'Screen will be set to mode 4 (320x200 color)');
      currentmode := 4;
      pressclear;
    end;
  currentmode := screenmode(page, numcolumn);
  newdisplay( graphics );    { display softkeys }
  palette(0, 1);	     { use palette 0; blue backgound }
  { print different color on the screen }
  if currentmode = 4 then begin
    lstringwrite(currentpage, 21,  0, 1, 'Color 1');
    lstringwrite(currentpage, 21, 10, 2, 'Color 2');
    lstringwrite(currentpage, 21, 20, 3, 'Color 3');
  end;
  messageuse;
  repeat
   while not inkey( lastch, lastscan ) do
     displaytime;
   if (lastscan = 0 ) and ( lastch = chr(0) ) then break;
   if lastscan = qesc then break;	    { out of the repeat loop }
   if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
     key := lastscan - scanf0;
     blankmessage;
     blinkkey(graphics, key, blinkrow, blinkcol );   { blinking the pressed key}
     case key of
      qpalette : begin
		palettenum := getint('palettenum (0:G/R/Y 1:C/M/W)');
		bcolor:= getint('background color (0..31)');
		palette(palettenum, bcolor);
	      end;

      qwritedot : begin
		x := askx;
		y := getint('y coordinate (0..199)');
		fcolor := askcolor;
		writedot(x, y, fcolor );
	      end;

      qreaddot : begin
		x := askx;
		y := getint('y coordinate (0..199)');
		fcolor := readdot(x,y);
		locate(currentpage, inforow, msgcol );
		writeln('color=',fcolor:3);
	      end;

      qdrawline : begin
		if currentmode = 6 then  begin
		   x := getint('x1 (0..639)') ;
		   y := getint('y1 (0..199)');
		   x2 := getint('x2 (0..639)')
		end
		else  begin
		   x := getint('x1 (0..319)');
		   y := getint('y1 (0..199)');
		   x2 := getint('x2 (0..319)')
		end;
		y2  := getint('y2 (0..199)');
		fcolor := askcolor;
		drawline(x,y,X2,Y2,fcolor);
	      end;

      qgetpic : begin
		if currentmode = 6 then begin
		   x  := getint('left x (0..639)');
		   y  := getint('lower y (0..199)');
		   x2 := getint('right x (0..639)');
		   i  :=abs( (x2+7)div 8-(x+7)div 8);	{width of the picture}
		end				     { in bytes }
		else begin
		   x  := getint('left x (0..319)');
		   y  := getint('lower y (0..199)');
		   x2 := getint('right x (0..319)');
		   i  :=abs ((x2+3)div 4  - (x2+3)div 4 );
		end;
		y2:= getint('upper y (0..199)');
		i := i*(abs(y2-y)+1)+2; 	{ total numbe of bytes }
		if i > picsize then begin
		  lstringwrite(currentpage, msgrow, msgcol, normal,
			'picture size > the declared size (1024)');
		  pressreturn;
		end
		else
		  getpic(x,y,X2,Y2,pic);
	      end;

      qputpic : begin
		x := askx;
		y := getint('lower y (0..199)');
		lstringwrite(currentpage, inforow, msgcol, normal,
			       '0:XOR; 1:PSET; -1:NEG; 2:OR; 3:AND ');
		action := getint('action(0..3)');
		putpic(x,y,action, pic);
		lstringwrite(currentpage, inforow, msgcol, normal,
			blanks);
	      end;

      qcircle : begin
		if currentmode = 6 then
		   x := getint('center x (0..639)')
		else
		   x := getint('center x (0..319)');
		y := getint('center y');
		width  := getint('width');
		height := getint('height');
		fcolor := askcolor;
		sangle := getint('starting angle');
		eangle := getint('ending angle');
		circle(x,y,width,height,fcolor,sangle,eangle);
	      end;

      qpaint: begin
		x := askx;
		y := getint('y (0..199)');
		fcolor := getint('interior color');
		bcolor := getint('boundary color');
		i  := getint('pattern');
		paint(x,y,fcolor,bcolor,i);
	      end;

      qview : begin
		if currentmode = 6 then  begin
		   x := getint('left x (0..639)') ;
		   y := getint('bottom y (0..199)');
		   x2 := getint('right x (0..639)')
		end
		else  begin
		   x := getint('left x (0..319)');
		   y := getint('bottom y (0..199)');
		   x2 := getint('right x (0..319)')
		end;
		y2  := getint('top y (0..199)');
		view(x,y,X2,Y2);
	      end;

      qlightpen : begin
		lstringwrite(currentpage, msgrow, msgcol,normal,
		       'Use Lightpen then Press any key');
		while not inkey( lastch, lastscan ) do{ while no key is pressed}
		  if lightpen(row, col, x, y) then begin
		     locate(currentpage, inforow, msgcol);
		     writeln('LIGHTPEN=TRUE', ' row=',row:1, ' col=', col:1,
				' x=',x:1, ' y=',y:1);
		  end
		  else begin
		     locate(currentpage, inforow, msgcol);
		     writeln('LIGHTPEN=FALSE');
		  end;
		displaych;
	      end;

      otherwise  { do nothing }
      end;	{ case end }
     messageuse;
     lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
	 , graphics[key]);	{ reset the blinking function key to reverse }
     end  { if scan < }
    else
      cursormoves( lastscan );
   until false;
end; { graphicsroutines }




{***** peripheralroutines - handle peripheral routines }
procedure peripheralroutines;
const
  qrandomize = 1;    qnumequip =2;
  qrnd =       3;    qprinter  =4;
  qsound =     5;    qexit     =10;
var
  blinkcol, blinkrow, seed, random, i, key : integer;
  peripheral[static] : softkeytype; ch : char;
  freq[static] : array[1 .. 7 ] of integer;

value
  peripheral[qrandomize]:='RANDOMIZE '; peripheral[qnumequip]:='NUMEQUIP  ';
  peripheral[qrnd      ]:='RND       '; peripheral[qprinter ]:='PRINTER   ';
  peripheral[	     5 ]:='SOUND     '; peripheral[       6 ]:='          ';
  peripheral[	     7 ]:='          '; peripheral[       8 ]:='          ';
  peripheral[	     9 ]:='          '; peripheral[   qexit ]:='EXIT      ';

  freq[1]:=523; freq[2]:=587; freq[3]:=659; freq[4]:=698;
  freq[5]:=784; freq[6]:=880; freq[7]:=988;
begin
  newdisplay( peripheral );    { display softkeys }
  messageuse;
  repeat
   while not inkey( lastch, lastscan ) do
     displaytime;
   if (lastscan = 0 ) and ( lastch = chr(0) ) then break;
   if lastscan = qesc then break;	    { out of the repeat loop }
   if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
     key := lastscan - scanf0;
     blankmessage;
     blinkkey(peripheral, key, blinkrow, blinkcol );   { blinking the pressed key}
     case key of
      qrandomize : begin
		seed := getint('seed (0..65535)');
		randomize(seed);
	      end;

      qrnd : begin
		lstringwrite(currentpage, 13, 0, normal,
		  'random numbers between 0 and 65535:');
		locate(currentpage, 14,0);
		for i := 1 to 5 do
		  write( rnd:7);

		lstringwrite(currentpage, 16, 0, normal,
		  'random numbers between -32768 and 32767:');
		locate(currentpage, 17,0);
		for i := 1 to 5 do begin
		  random := rnd;		  { random is an integer }
		  write( random:7);
		end;

		lstringwrite(currentpage, 19, 0, normal,
		  'random numbers between 1 and 6(for dice):');
		locate(currentpage, 20,0);
		for i := 1 to 19 do  begin
		  random := rnd mod 6 + 1;
		  write( random:2 );
		end;
	     end; {qrnd}

      qnumequip :begin	{find all the equipments }
		locate(currentpage,13,0);
		writeln('NUMDISK   =',numdisk:5,  '  NUMPRAM   =',numpram:5);
		locate(currentpage,15,0);
		writeln('NUMGAME   =',numgame:5,  '  NUMCOMM   =',numcomm:5);
		locate(currentpage,17,0);
		writeln('NUMMEMORY =',nummemory:5,'  NUMPRINTER=',numprinter:5);
		end;

     qprinter : begin
		prtinit(0);
		if prtstatus(0) =  0 then begin
		  regular(0);
		  prtlstring(0,'regular');
		  compress(0);
		  prtlstring(0,'compress');
		  regular(0);	dblwidth(0);
		  prtlstring(0,'dblwidth');
		  regular(0);	emphasize(0);
		  prtlstring(0,'emphasize');
		  regular(0);	dblstrike(0);
		  prtlstring(0,'dblstrike');
		  regular(0);
		end
		else begin
		  locate(currentpage, inforow, msgcol);
		  writeln(' PRTSTATUS=', prtstatus(0));
		end;
	      end;

      qsound :begin
		for i := 1 to 7 do
		  sound( freq[i], 50); { half second for each note }
		sound(0, 100);	       {waiting for one second }
		for I := 7 downto 1 do
		  sound( freq[i], 100);{ 1 second for each note}
	      end;

      qexit : break;

      otherwise  { do nothing }
      end;	{ case end }
     messageuse;
     lstringwrite(currentpage, blinkrow, blinkcol, rcolor[currentmode]
	 ,peripheral[key]);	 { reset the blinking function key to reverse }
     end  { if scan < }
    else
      cursormoves( lastscan );
   until false;
end; { peripheralroutines }




{***** mainmunu - the main menu }
procedure mainmenu;
const
  { topmenu keys }
  qdemos     = 1;	 qgraphics   = 2;
  qdemosall  = 3;	 qperipheral = 4;
  qdemog     = 5;	 qscreen1    = 6;
  qfastscroll= 7;	 qscreen2    = 8;
  qslowscroll= 9;	 qexit	     = 10;

  lastmsg   = 15;	 lastmsgp1 = lastmsg+1;
  brow	   = 21; trow = 12;  { bottom and top row number for the scrooling
				message window }
  delayinc = 100;

var
  topmenu[static] : softkeytype;
  nextmsg, key: integer;
  msg[static] : array[0..lastmsg] of lstring(40);
  delay : integer;	     { delay count for displaying }
  count : integer;	     { when count >= delay then display a new message}

value
  topmenu[ qdemos     ] := 'DEMOS     ';  topmenu[ qgraphics  ] := 'GRAPHICS  ';
  topmenu[ qdemosall  ] := 'DEMOSALL  ';  topmenu[ qperipheral] := 'PERIPHERAL';
  topmenu[ qdemog     ] := 'DEMOG     ';  topmenu[ qscreen1   ] := 'SCREEN1   ';
  topmenu[ qfastscroll] := 'FastScroll';  topmenu[ qscreen2   ] := 'SCREEN2   ';
  topmenu[ qslowscroll] := 'SlowScroll';  topmenu[ qexit      ] := 'EXIT      ';
  msg[0] := 'Press F1, F2,...F9, F10 to select the   ';
  msg[1] := ' corresponding command  e.g. F1=DEMOS.  ';
  msg[2] := 'Press ESC to exit this command level.   ';
  msg[3] := blanks;
  msg[4] := 'DEMOS     -screen text color table demo.';
  msg[5] := 'DEMOSALL  -all text  color  tables demo.';
  msg[6] := 'DEMOG     -graphics,  animation,  music.';
  msg[7] := 'FastScroll-Scroll these messages faster.';
  msg[8] := 'SlowScroll-Scroll these messages slower.';
  msg[9] := blanks;
  msg[10]:= 'GRAPHICS  -Enters the  GRAPHICS  Driver.';
  msg[11]:= 'PERIPHERAL-Enters the PERIPHERAL Driver.';
  msg[12]:= 'SCREEN1   -Enters the SCREEN1    Driver.';
  msg[13]:= 'SCREEN2   -Enters the SCREEN2    Driver.';
  msg[14]:= ' You may test each routine in a  Driver.';
  msg[15]:= blanks;

begin
  newdisplay( topmenu );	     { display function keys }
  lstringwrite(currentpage, 0, 8, normal, ' PASCAL Utilities by SoftwareLab');
  messageuse;			     { use function key }
  nextmsg := lastmsg;
  delay := initialdelay;		  {initial delay elapse period }
  count := delay;
  repeat			     { until ESC or EXIT is pressed }
    while not inkey( lastch, lastscan) do { while no key is pressed update time}
    begin				  { and display messages }
      displaytime;
      { increment count until it is greater than delay then display a line }
      if count >= delay then begin
	count := 0;
	{ rotating using the message }
	if nextmsg >= lastmsg then	    { rotate the displaying message }
	  nextmsg := 0
	else
	  nextmsg := nextmsg + 1;
	scroll('U', 1, trow, 0, brow, 39, normal);     { scroll the message }
	lstringwrite(currentpage, brow, 0, normal, msg[nextmsg]); {new message}
      end	{ count >= delay }
      else
	count := count +1;
    end; { end of while waiting for inkey }
    if (lastscan = 0 ) and ( lastch = chr(0) ) then break;
    if lastscan = qesc then break;	 { out of the repeat loop for ESC pressed}
    if ( lastscan > scanf0 ) and ( lastscan <= scanf10 ) then begin
      key := lastscan -scanf0;
      if key = qfastscroll then
	delay := delay - delayinc
      else
	if key = qslowscroll then
	  delay := delay + delayinc
	else begin	{ regular routines }
	  blankmessage;
	  scroll('u', 0, trow, 0, brow, 39, normal); {scroll the entire window}
	  scroll('u', 1, 0, 0, 23, 79, normal);      {reset the scroll window}
	  case key of
	   qscreen1  :	screen1routines;
	   qscreen2  :	screen2routines;
	   qgraphics :	graphicsroutines;
	   qdemos    :	demos;
	   qdemosall :	demosall( delay );
	   qdemog    :	demog;
	   qperipheral: peripheralroutines;
	   qexit     :	break;
	   otherwise  { do nothing }
	  end; { case }
	  newdisplay( topmenu );
	  nextmsg := lastmsg;
	  messageuse;			     { use function key }
	end;  { key <> qfaster and key <> qslower }
      end		     { if scan > scanf > scanf0 and scan <= scanf10 }
    else
      cursormoves( lastscan );
  until false;		       { break for ESC or exit }
  screen(currentmode);
end; { mainmenu }




{***** initialize - initialize global variables }
procedure initialize;
begin
 currentmode := screenmode( currentpage, currentcol );
 if currentmode = 7 then	{ Monochrome Display Adapter returns 7 }
    screen(currentmode)
 else
    screen(4);		{40x25 color mode }
 currentmode := screenmode( currentpage, currentcol );
 if currentmode = 7 then currentpage := 0;
 readcursor(currentpage, currentrow, currentcol, currentstart, currentstop);
 currentcol := homecol;  currentrow := homerow;    { set the cursor position}
 end; { initialize }

{***** logo - print ordering message}
procedure logo;
begin
  lstringwrite(0, 0, 0, normal,   'This is a  demo program  for the  Pascal');
  lstringwrite(0, 1, 0, normal,   'Utilities Package which consists of over');
  lstringwrite(0, 2, 0, normal,   'seventy assembly language routines to be');
  lstringwrite(0, 3, 0, normal,   'called from  IBM PC DOS Pascal programs.');
  lstringwrite(0, 4, 0, normal,   'The routines control');
  lstringwrite(0, 4,22,intensity, 'screen,  keyboard,');
  lstringwrite(0, 5, 0,intensity, 'graphics, joyticks, light pen, printers,');
  lstringwrite(0, 6, 0,intensity, 'music, and communication ports.');
  lstringwrite(0, 7, 0, normal,   'The file  "mini.obj"  on this  demo disk');
  lstringwrite(0, 8, 0, normal,   'contains only  several routines from the');
  lstringwrite(0, 9, 0, normal,   'Pascal Utilities package.   Price of the');
  lstringwrite(0,10, 0, normal,   'complete  package  including a  110 page');
  lstringwrite(0,11, 0, normal,   'manual is  $119.00.');
  lstringwrite(0,12, 0, normal,   'To order it, please send a check or give');
  lstringwrite(0,13, 0, normal,   'VISA/MC number and expiration date to:');
  lstringwrite(0,15,10,intensity, 'Software Labs');
  lstringwrite(0,16,10,intensity, '1052 Lily Ave.');
  lstringwrite(0,17,10,intensity, 'Sunnyvale, CA 94086');
  lstringwrite(0,18,10,intensity, '(408)-241-9539');
  lstringwrite(0,20, 0, normal,   'Similar  utilities packages for  Fortran');
  lstringwrite(0,21, 0, normal,   'and Lattice C are available  at $119.00.');
  pressreturn;
end; {logo}

begin { main program }
  initialize;		    {initilize screen variables }
  logo; 		    { message}
  mainmenu;		    { execute the main menu }
  end.			    { main }
cts the color for the boarder for color text mode }

nction numgame:integer;   extern; { number of game I/O (0-1) }
fun