home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / vol_300 / 349_01 / sss.arc / EX_0702.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-10  |  3KB  |  138 lines
  1. program EX_0702;
  2. {Listing 15P - see documentation in TUTOR.SSS}
  3.  
  4. uses SSS;
  5. { For Pascal other than Turbo/Quick erase above line }
  6.  
  7. const
  8.   WHITE  = 1;
  9.   BLUE   = 2;
  10.   RED    = 3;
  11.   YELLOW = 4;
  12.  
  13.   MAINP  = 1;
  14.   COVER  = 2;
  15.   MREQ   = 3;
  16.  
  17.   ARRIVL = 1;
  18.   STARTA = 2;
  19.   ENDACT = 3;
  20.   NEXTAC = 4;
  21.   MATCH  = 5;
  22.  
  23. { For MS Pascal $include:'SSSP1.H' }
  24.  
  25. var
  26.   ecode, server : integer;
  27.  
  28. { For MS Pascal $include:'SSSP2.H' }
  29.  
  30. procedure prime;
  31. begin
  32.   server := 1;
  33.   INIQUE(2,1,1);
  34.   SIMEND(150);
  35.   CREATE(EX(12), MAINP);
  36.   CREATE(EX(12), COVER);
  37. end;
  38.  
  39. function other: integer;
  40. begin
  41.   if IDE = MAINP then other := COVER
  42.   else                other := MAINP;
  43. end;
  44.  
  45. procedure find1;
  46. var i, o: integer;
  47. begin
  48.   i := 1;
  49.   o := other;
  50.   while ((i <= NQ(o)) and (AIQ(o,i,1) <> A(1)))
  51.     do i := i + 1;
  52.   if i <= NQ(o) then
  53.   begin
  54.     DISPOS;
  55.     REMVFQ(o, i);
  56.     SCHED(0, STARTA, IDE);
  57.   end else QUEUE(IDE, 0);
  58. end;
  59.  
  60. procedure find2;
  61.   var i, j: integer;
  62.   color: real;
  63.   found: Boolean;
  64. begin
  65.   found := false;
  66.   j := 1;
  67.   repeat
  68.     color := AIQ(MAINP, j, 1);
  69.     i := 1;
  70.     while ((i <= NQ(COVER)) and
  71.            (AIQ(COVER,i,1) <> color)) do i := i + 1;
  72.  
  73.     if i <= NQ(COVER) then
  74.     begin
  75.       REMVFQ(COVER, i);
  76.       DISPOS;
  77.       REMVFQ(MAINP, j);
  78.       found := true;
  79.     end else j := j + 1;
  80.   until (found or (j > NQ(MAINP)));
  81. end;
  82.  
  83. begin
  84.  
  85.   prime;
  86.  
  87.   repeat
  88.     ecode := NEXTEV;
  89.     if ecode > 0 then
  90.     begin
  91.       case ecode of
  92.  
  93.       ARRIVL: if IDE = MREQ then SCHED(0, MATCH, IDE)
  94.               else
  95.               begin
  96.                 CREATE(EX(12), IDE);
  97.                 if RA < 0.35 then SETA(1, WHITE ) else
  98.                 if RA < 0.50 then SETA(1, BLUE  ) else
  99.                 if RA < 0.80 then SETA(1, RED   ) else
  100.                                   SETA(1, YELLOW);
  101.                 SCHED(0, NEXTAC, IDE);
  102.               end;
  103.  
  104.       NEXTAC: if ((server > 0) and (NQ(other) > 0))
  105.                 then SCHED(0, MATCH, IDE)
  106.                 else QUEUE(IDE, 0);
  107.  
  108.       MATCH:  begin
  109.                 if IDE = MREQ then
  110.                 begin
  111.                   DISPOS;
  112.                   find2;
  113.                 end
  114.                 else
  115.                   find1;
  116.                 if NCEN > 0 then SCHED(0, STARTA, IDE);
  117.               end;
  118.  
  119.       STARTA: begin
  120.                 server := server - 1;
  121.                 SCHED(RN(10, 2), ENDACT, IDE);
  122.               end;
  123.  
  124.       ENDACT: begin
  125.                 DISPOS;
  126.                 server := server + 1;
  127.                 if ((NQ(MAINP) > 0)and(NQ(COVER) > 0))
  128.                   then CREATE(0, MREQ)
  129.                end;
  130.  
  131.       end;
  132.     end;
  133.   until ecode = 0;
  134.  
  135.   SUMRY('');
  136.  
  137. end.
  138.