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.BAS < prev    next >
BASIC Source File  |  1991-04-10  |  3KB  |  132 lines
  1. ' Program EX_0702.BAS
  2. ' Listing 15B - see documentation in TUTOR.SSS
  3.  
  4. const ARRIVL = 1, STARTA = 2, ENDACT = 3, NEXTAC = 4
  5. const MATCH = 5
  6. const WHITE = 1, BLUE = 2, RED = 3, YELLOW = 4
  7. const MAINP = 1, COVER = 2, MREQ = 3
  8.  
  9. common shared server, ecode
  10.  
  11. declare sub prime ()
  12. declare sub find1 ()
  13. declare sub find2 ()
  14. declare function other ()
  15.  
  16. rem $include: 'SSSB.H'
  17.  
  18.   call prime
  19.  
  20.   do
  21.     ecode = NEXTEV
  22.     if ecode > 0 then
  23.       select case ecode
  24.  
  25.       case ARRIVL
  26.                if IDE = MREQ then
  27.                  SCHED 0, MATCH, IDE
  28.                else
  29.  
  30.                  CREATE EX(12), IDE
  31.                  if RA < .35 then
  32.                    SETA 1, WHITE
  33.                  elseif RA < .5 then
  34.                    SETA 1, BLUE
  35.                  elseif RA < .8 then
  36.                    SETA 1, RED
  37.                  else
  38.                    SETA 1, YELLOW
  39.                  end if
  40.                  SCHED 0, NEXTAC, IDE
  41.                end if
  42.  
  43.       case NEXTAC
  44.                if server > 0 and NQ(other) > 0 then
  45.                  SCHED 0, MATCH, IDE
  46.                else
  47.                  QUEUE IDE, 0
  48.                end if
  49.  
  50.       case MATCH
  51.                if IDE = MREQ then
  52.                  DISPOS
  53.                  find2
  54.                else
  55.                  find1
  56.                end if
  57.                if NCEN > 0 then SCHED 0, STARTA, IDE
  58.  
  59.       case STARTA
  60.                server = server - 1
  61.                SCHED RN(10, 2), ENDACT, IDE
  62.  
  63.       case ENDACT
  64.                DISPOS
  65.                server = server + 1
  66.                if NQ(MAINP) > 0 and NQ(COVER) > 0 then
  67.                  CREATE 0, MREQ
  68.                end if
  69.  
  70.       end select
  71.     end if
  72.   loop while ecode > 0
  73.  
  74.   title$ = "  "
  75.   SUMRY sadd(title$)
  76.  
  77. sub find1
  78.   i = 1
  79.   o = other
  80.   if NQ(o) > 0 then
  81.     for j = 1 to NQ(o)
  82.       if AIQ(o, i, 1) = A(1) then exit for
  83.       i = i + 1
  84.     next j
  85.   end if
  86.  
  87.   if i <= NQ(o) then
  88.     DISPOS
  89.     REMVFQ o, i
  90.     SCHED 0, STARTA, IDE
  91.   else
  92.     QUEUE IDE, 0
  93.   end if
  94. end sub
  95.  
  96. sub find2
  97.   found = 0
  98.   j = 1
  99.   do
  100.     colr = AIQ(MAINP, j, 1)
  101.     i = 1
  102.     if NQ(COVER) > 0 then
  103.       for k = 1 to NQ(COVER)
  104.         if AIQ(COVER, k, 1) = colr then exit for
  105.         i = i + 1
  106.       next k
  107.     end if
  108.  
  109.     if i <= NQ(COVER) then
  110.       REMVFQ COVER, i
  111.       DISPOS
  112.       REMVFQ MAINP, j
  113.       found = 1
  114.     else
  115.       j = j + 1
  116.     end if
  117.   loop while found = 0 and j <= NQ(MAINP)
  118. end sub
  119.  
  120. function other
  121.   if IDE = MAINP then other = COVER else other = MAINP
  122. end function
  123.  
  124. sub prime
  125.   server = 1
  126.   INIQUE 2, 1, 1
  127.   SIMEND 150
  128.   CREATE EX(12), MAINP
  129.   CREATE EX(12), COVER
  130. end sub
  131.  
  132.