{(C) Copyright Software Labs. 1982 }
{$include:'b:demog.inc'}    {this line is not in the listing of the manual }
{$include:'b:gunit.inc'}
{ Demog.pas - graphics, music, scrolling demo for the Pascal Utilities }
{ Draw a pie, bar, and line charts and a moving logo and graphics cursor}

implementation of demogunit;
USES SoftwareLabsg(initgunit, window, viewport,draw,move,cursor,
	cursorc, circlg, pie, bar);

{$include:'b:plib.inc'}
{$include:'b:glib.inc'}
{$include:'b:alib.inc'}
{$include:'b:slib.inc'}
{$debug-}
procedure demog;

{ these constant divide the screen into three viewport }
const ymax=199; xmax=319; ysep1=49; xsep2=150;ysep2=119;sharesize=10;
      sinesize = xmax-xsep2-1;	pitime2=6.28319;

var share : array [1..sharesize] of integer; sum, maxshare, lastshare : integer;
    sine : array[ 0 .. sinesize] of real;
    ls : lstring(80); picrab : array[0 .. 1 ] of string(616);	 {stores rabbit}
		      pictur : array[0 .. 1 ] of string(392);	 {stores turtle}
    ch : char; i, scan, mode, page, numcol : integer;
    musicnum : integer; 				     {0 if no music }


{***** playmusic - plays music }
procedure playmusic;
const
  lastsong = 4;
type
  stype = array[ 1 .. lastsong ] of lstring(100);
var
  s1[static] : stype;	s2[static] : stype;  s3[static] : stype;
value
 {Yankee DooDo}
 S1[1]:='11231325|1123175|11234321|756711|6.7656716|5.654345|6.7656716|517211|';
 S2[1]:='-------- ---- -- -------- ----   - =------ - =----  - =------ ----   ';
 S3[1]:='^^^^^^^  ^^^^^   ^^^^^^^^     ^^        ^                  ^   ^ ^^^ ';

 {Humourous part 1}
 S1[2]:='1.21.23.56.51.72.17.21.65.56.51.65.32---';
 S2[2]:='- =- =- =- =- =- =- =- =- =- =- =- =    ';
 S3[2]:='^ ^^ ^^ ^^ ^~ ^~ ~^ ~~ ^^ ^^ ^~ ^^ ^^   ';

 {Humourous part 2}
 S1[3]:='1.21.23.56.56.72.17.21.65.53.5 4.32.61---';
 S2[3]:='- =- =- =- =- =- =- =- =- =- = - =- =    ';
 S3[3]:='^ ^^ ^^ ^^ ^^ ^~ ~^ ~~ ^^ ^~ ^ ^ ~~ ^~   ';

 {Go Hell}
 S1[4]:='312312342342345634123215-312312342342345634123.5321-113535---';
 S2[4]:=' ------ ------  ---- --   ------ ------  ----- =--   --      ';
 S3[4]:='                                                    ~~~~~~   ';
begin
     { musicnum = 0 for no music, otherwise the current music }
     if musicnum > 0 then		{ need music }
       if not musicon then begin	{ check if music stops }
	 if musicnum >= lastsong then
	   musicnum := 1
	 else
	   musicnum := musicnum + 1;
	 musicload('F',1,s1[musicnum ], s2[musicnum], s3[musicnum]);
	 musicgo;
       end;
end; {playmusic}





{ ***** asksharedata - enter share data; find maximum and total }
procedure asksharedata;
var i, sinesized4, sinesized2, j : integer; angle,angleinc,  sinedata : real;
begin
  locate(0,0,0); putlstring( 0,7,'Loading data');
  { assign share data }
  share[1] := 15; share[2] := 18; share[3] := 6; share[4] := 14;
  share[5] := 9;  share[6] := 14; share[7] := 20; share[8] := 14;
  lastshare := 8;    maxshare := 0; sum:= 0; { initialize to find size and max}
  for i := 1 to lastshare do begin
   sum := sum+share[i];
   if share[i] > maxshare then maxshare := share[i]
  end;
  { loading data for sine chart }
  angle := 0; sinesized2 := sinesize div 2; sinesized4 := sinesize div 4;
  angleinc := pitime2 / sinesize;   j := sinesized4;
  for i := 1 to j do begin
    if inkey( ch, scan ) then return;	     { return if any key is pressed}
    sinedata := sin(angle); sine[i] := sinedata; sine[sinesized2-i] := sinedata;
    sine[sinesized2+i] := -sinedata; sine[sinesize-i] := -sinedata;
    angle := angle+angleinc;
  end;
  locate(0,0,0); putlstring( 0,7,'            ');
end; { asksharedata }




{ ***** piechart - plot pie chart for share data }
procedure piechart;
const  piestartangle = 0.14;
var i,j: integer; sangle,eangle, scale, angle : real;
begin
  locate(0,0,0);
  viewport(0, ysep1, xsep2, ymax);
  window( -1.0, -1.0, 1.0, 1.0); { a unit window for pie }
  scale := pitime2/sum;  sangle := piestartangle; { starting angle for pie }
  eangle:=scale*share[1] + sangle;
  { pull out the first pie }
  angle := ( sangle + eangle)/2;
  pie(0.18*cos(angle), 0.18*sin(angle), 0.6,0.6, sangle, eangle, 1,2,1);
  for i := 2 to lastshare do begin
   if inkey( ch, scan ) then return;	    { return if any key is pressed}
   sangle:=eangle;	eangle:= scale*share[i]+sangle;
   pie(0.0, 0.0, 0.6,0.6, sangle, eangle, 3,1,i);  {use i as the pattern}
   playmusic;
  end;
end; { piechart }





{ ***** barchart - plot bar chart for share data }
procedure barchart;
const patstart = 14;
var i : integer; xinc, yscale,x1,x2 : real;
begin
  viewport( xsep2,ysep2, xmax, ymax);
  window( 0.0, 0.0 , 1.0, 1.0); { a unit window for bar}
  move(0.1,0.9); draw(0.1, 0.1,3); draw(0.9, 0.1, 3); { axis }
  xinc := (0.8-0.1)/lastshare; yscale := (0.8-0.1)/maxshare; x1 := 0.15;
  for i := 1 to lastshare do begin
    if inkey( ch, scan ) then return;	     { return if any key is pressed}
    playmusic;
    x2 := x1 + xinc;
    bar(x1,0.1, x2, yscale*share[i], 1,2, i+patstart);
    x1 := x2;
  end;
end; { barchart }




{ ***** linechart - plot a sine and  a cosine graph }
procedure linechart;
var i,j, lasti : integer; xinc,x1, angleinc, angle: real;
begin
  viewport( xsep2,ysep1, xmax, ysep2);
  window(-0.1,	-1.1 , 1.1, 1.1); { a unit window for bar}
  move(0.0, 1.0); draw(0.0, -1.0,2); draw(1.0,-1.0, 2); { axis }
  { plot a sine curve }
  {lasti := round(xmax-xsep2); xinc := 1.0/lasti;  x1 := 0.0;
  angleinc := 2.0*pi/lasti; angle := 0; move(x1, sin(angle));
  for i := 1 to lasti do begin
    x1 := x1+xinc; angle := angle+angleinc;  draw(x1, sin(angle),1) end;}

  xinc := 1.0/sinesize; x1 := 0.0; i := 1;  move(x1, sine[i]);
  for i := 1 to sinesize  do begin
   playmusic;
   if inkey( ch, scan ) then return;	    { return if any key is pressed}
   x1 := x1 +xinc;
   draw(x1,sine[i],3)
  end;
  { plot a cosine with double frequency }
  x1 := 0.0; j := sinesize div 4;  move(x1, sine[j]);
  for i := 1 to sinesize  do begin
   if inkey( ch, scan ) then return;	    { return if any key is pressed}
   playmusic;
   x1 := x1 +xinc; j:=j+2;
   if j >= sinesize then j := 1;
   draw(x1,sine[j],1)
  end;
end; { linechart }




{**** createrabbit - create a rabbit using the screen }
procedure createrabbit;
begin
  {head with an open mouth}
  view(0,0,319,199);
  circle(16,16,15,16,2, -355, -315);	   {head }
  circle(20,24,4,3,2, 0,360);		   {open eye}
  paint(10, 16, 3, 2, 1);
  {left ear}
  circle(56,36,50,50,2, 143,189);
  circle(-32,52,50,50,2, 336,16);
  paint(16,40,1,2,4);
  {right ear}
  circle(56,24,50,50,2,126,140);
  circle(-24,60,50,50,2, 326,5);
  paint(20,48,1,2,4);
  getpic(0,0,32,65,picrab[0]);
  putpic(0,0,0,picrab[0]);	   {erase the original picture}
  {head with a closed mouth}
  circle(16,16,15,16,2,  -355, -350);
  drawline(16,24,24,24,2);	{closed eye}
  paint(10, 16, 3, 2, 1);
  {left ear}
  circle(56,36,50,50,2, 143,189);
  circle(-32,52,50,50,2, 336,16);
  paint(16,40,1,2,4);
  {right ear}
  circle(56,24,50,50,2,126,140);
  circle(-24,60,50,50,2,326,5);
  paint(20,48,1,2,4);
  getpic(0,0,32,67,picrab[1]);
  putpic(0,0,0,picrab[1]);	   {erase the original picture}
end; {createrabbit}



{*****creatturtle - create a turtle using the screen }
procedure createturtle;
begin
  circle(22,16,18,10,3, 0,360); {body}
  paint(22,16,2,3, 10);
  circle(22,16,22,6,3,350,10);	{head}
  circle(24,24,8,8,3,0,45);	{left hand }
  circle(4,24,8,8,3,0,45);	{left foot}
  circle(4,8,8,8,3,315,360);	{right foot}
  circle(24,8 ,8,8,3,315,360);	{right hand}
  circle(8,8,8,8,3,90, 135);	{tail }
  getpic(0,0, 44,31, pictur[0]);{store it}
  circle(8,8,8,8,128+3,90, 135);{erase tail }
  circle(8,24,8,8,3,180 , 225); { new tail }
  getpic(0,0, 44,31, pictur[1]);{store it}
  putpic(0,0,0,  pictur[1]);	   {erase it from the screen}
end; { createturtle }




{****** use the next  palette }
procedure nextpalette(var palettenum, bcolor : integer);
begin
  if bcolor >= 15 then begin
    if palettenum = 0 then	 { change palette }
      palettenum := 1
    else
      palettenum := 0;
    bcolor := 0;
  end
  else
    bcolor := bcolor + 1;
  palette( palettenum, bcolor);
  locate(0,20,0);
  write('Palette number =',palettenum:1,'    Background=',bcolor:2);
end; {next palette }



{ ***** moving - moves a logo along the x axis }
procedure moving;
const logoy=50; gxstart = 0;
var gx,nx,			    { rabbit  x positions current and new }
    gtx, ntx, gty, nty, 	    {turtle  position  }
    gcx,gcy,			    {cursor positions }
    scan,ni,gi,count,palettenum,bcolor:integer;ch:char;
    withjoystick : boolean;	    { if it has a joystick, it controls the
				      graphics cursor, otherwise the graphics
				      cursor use the same x postion for logo,
				      and use a random number for y position}
    ax,ay,bx,by,a1,a2,b1,b2 : integer; {joystick }
begin { moving }
  view(0,0, 319,199);
  if numgame > 0 then
    withjoystick := true
  else
    withjoystick := false;
  gx:=gxstart;	 gi:=0; gtx := gxstart; gty:= 150; { initialization }
  putpic(gx,logoy,0,picrab[gi]);
  putpic(gtx,gty,0, pictur[gi]);
  palettenum := 0; bcolor := 0;

  while not inkey( ch, scan ) do begin

   { new position for turtle }

   if withjoystick then begin
     joystick(ax,ay,bx,by,a1,a2,b1,b2);
     if ax =  25 then withjoystick := false;	 { user unplug it ; use random}
     if ax >= 10 then begin
	if gtx + 10 < 270 then			{ limit in bound }
	  ntx := gtx + 10
	else
	  ntx := 0;
     end
     else if ax <= 6 then begin
       if gtx - 10 >= 0 then
	ntx := gtx - 10;
     end
     if ay >= 11 then begin
	if gty + 10 <= 165 then
	nty := gty + 7
     end
     else if ay  <= 7 then
       if gty - 10 >= 0 then
	nty := gty - 7;
   end;        { with joystick }
   if ntx >= 270 then
       ntx := 0
   else
       ntx := ntx + 1;

   { new x position for rabbit }
   if gx >= 300 then begin		     { touch the right boundary}
     nx := gxstart;			      { from leftmost }
     nextpalette(palettenum, bcolor);
   end
   else 				     { moving to the right }
     nx := gx + 4;


   { new y position for the graphics cursor  from random number }
   gcy := rnd mod 200;			      {returns 0 to 199 }

   { which pattern to use for the rabbit }
   if gi = 0 then
     ni := 1
   else
     ni := 0;

   { now move to the new position }
   cursorg(ntx,gcy);				{move the graphics cursor}
   putpic(gx, logoy, 0, picrab[gi]);		{erase the previous picture}
   putpic(nx, logoy, 0, picrab[ni]);		{create new object}
   putpic(gtx,	gty, 0, pictur[gi]);		{erase the previous picture}
   putpic(ntx,	nty, 0, pictur[ni]);		{create new object}
   gx := nx;	gi := ni;  gtx := ntx; gty := nty;    {new items}
   playmusic;
  end;					    {while }
end; { moving }




{ ***** message - print copyright and instruction }
procedure message;
const  intensity=15;
begin
  locate(0,24,2);
  putlstring(0,2,'(C)Copyright Software Labs 1983');
  locate(0,22,7);
  putlstring(0,intensity,'Presse any key to exit');
  locate(0,23,0);
  putlstring(0,intensity,'Pascal Utilities  by Software Labs');
end; { message }



{ ***** demographics - demo pie, bar, line and moving object }
procedure demographics;
begin
  asksharedata;
  piechart;
  barchart;
  linechart;
  moving;
end; { demographics }





{******selectmusic - ask whether the user need background music }
procedure selectmusic;
begin
  putlstring(0,2,'background music (y/n) ? ');
  while not inkey (ch, scan ) do { do nothing }  ;
  if ( ch = 'y' ) or ( ch = 'Y') then begin
     musicinit; 				      {initialize music}
     musicnum := 1;
     playmusic;
  end;
end;



{ ***** demopattern - display all the patterns }
procedure demopattern;
const  rsize = 4; csize = 10; xsize=24; ysize=24; xstart=50; yend=170;
       ystart=74; xend=290; qnumlock=69;
var
  x,y,row, col,  pattern, bcolor, palettenum, count: integer;
begin
  locate(0,0,14);
  putlstring(0, 2, 'Pattern Tables');
  {print lables }
  locate(0, 2, 7);
  putlstring(0, 1, '0  1  2  3  4  5  6  7  8  9');       { vertical label }
  locate(0,5,4); putchar(0, 1, 1, '0');                   { horizontal label }
  locate(0,8,4); putchar(0, 1, 1, '1');
  locate(0,11,4); putchar(0, 1, 1, '2');
  locate(0,14,4); putchar(0, 1, 1, '3');
  { grid}
  x := xstart;
  while x <= xend do begin
    if inkey( ch, scan ) then return;	     { return if any key is pressed}
    drawline(x, ystart, x, yend, 3);
    x := x + xsize;
  end;
  y := ystart;
  while y <= yend do begin
    if inkey( ch, scan ) then return;	     { return if any key is pressed}
    drawline(xstart, y, xend, y, 3);
    y := y + ysize;
  end;
  { paint each box by puting a seed }
  pattern := 0;
  y := yend - 4;
  for row := 1 to rsize do begin
    x := xstart+4;
    for col := 1 to csize do begin
      if inkey( ch, scan ) then return;        { return if any key is pressed}
      paint(x, y, 2, 3, pattern);	{ interior color= 2; boundary = 3}
      pattern := pattern+1;
      x := x + xsize;
      playmusic;
    end;
    y := y-ysize;			{ for the next y }
  end;
  palettenum := 0; bcolor := 0;
  while not inkey(ch, scan) do
    { delay until a key is pressed; chage palette when count reach 1000 }
    if count < 2000 then begin
      playmusic;
      count := count + 1
      end
    else begin
      count := 0;
      nextpalette(palettenum,bcolor);
    end;
  if scan = qnumlock then readln(ch);  {freeze it untill a key is pressed }
end;  { demopattern}





{***** demoscreen - demostrate scroll and music }
procedure demoscreen(mode : integer);
const
  lastmsg   = 10;  trow=11; brow=21;
var
  nextmsg, key: integer;
  msg[static] : array[0..lastmsg] of lstring(40);

value
  msg[0] := 'Yes, this demo program is written in DOS';
  msg[1] := 'Pascal calling the Pascal Utilities.    ';
  msg[2] := 'The following scrolling messages are:   ';
  msg[3] := 'You don not have to worry the effifiency';
  msg[4] := 'of the Pascal Utilities.   It is written';
  msg[5] := 'in Macro Assembly Language calling BIOS.';
  msg[6] := 'Efficient  algorithms  control   screen,';
  msg[7] := 'keyboard,  graphics,  music,  joysticks,';
  msg[8] := 'lightpen,  communication (RS232)  ports,';
  msg[9] := 'and equipments.  It controls a  PC  from';
  msg[10]:= 'inside your Pascal programs.            ';

begin
  screen(mode);
  selectmusic;
  screen(mode);
  { print the static message }
  for nextmsg := 0 to lastmsg do begin
    locate(0, nextmsg, 0);
    putlstring(0, 2, msg[nextmsg]);
  end;
  { scroll messages }
  message;
  nextmsg := lastmsg;
  while not inkey( ch, scan) do 		{ while no key is pressed}
  begin 					{ display messages }
	{ 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, 2);         { scroll the message }
	locate(0, brow, 0);
	putlstring(0, 2, msg[nextmsg]); 	     {new message}
	playmusic;
  end;
end; { demoscreen }




begin { main }
   musicnum := 0;
   mode := screenmode( page, numcol);
   screen(mode);
   writeln('Selects Graphics or Screen demo');
   putlstring(0,2,'Enter "G" or "S" > ');
   while not inkey(ch, scan ) do  { do nothing } ;
   if ( ch <> 'G' ) and ( ch <> 'g' ) then
     demoscreen(mode)
   else 						  { graphics demo }
    if mode = 7 then begin			       {monochrome monitor}
     screeng(mode);
     putlstring(0,1,'Graphics Demo Cannot run without Graphics/Color Adapter');
    end
    else  begin
     initgunit(4); { mode 4 : 320*200 color; 5 : 320*200 B/W; 6: 640*320 B/W}
     selectmusic;				   { select background music }
     screeng(4);
     message;
     demopattern;
     screeng(4);
     palette(0,1);
     createrabbit;
     createturtle;
     message;
     demographics;
    end;
  screen( mode);
  if musicnum > 0 then	musicstop;
end;
begin
end.