' simulazione smistamento delle telefonate
DECLARE SUB AR (x!, x$)
DECLARE SUB NORM (m!, s!, x!)
DECLARE SUB ESP (m!, x!)
DIM t(20), m(20), O(20)
WIDTH 80
determ = 0'con determ=1 viene effettuata una simulazione deterministica con dt
          'arrivi pari a 9 sec e durata telefonata pari a 50 sec
PRINT "Programma che simula lo smistamento delle telefonate presso l'organizzazione"
PRINT "di cui al programma ARRIVTEL nel periodo di punta, tra le 15:12 e le 15:30"
PRINT
' macchina 0: genera una telefonata in arrivo
' macchina N (N>0): passa la telefonata alla linea N generandone la durata
' t(i) = tempo fra cui Š riattivabile la macchina i-esima, registrato
'        dall'orologio locale i-esimo
' m(0) = macchina che Š riattivabile per 1a, m(1) = ... per 2a,...
' O(i) = 1 se la macchina i-esima Š impegnata, = 0 se non lo Š
' (la macchina 0, tranne nell'istante in cui genera, Š sempre libera)
' t = tempo sull'orologio generale
' na = tel.arrivate, nr = tel.ricevute, nc = tel.in corso
' coda = 1/0 se Š/non Š arrivata una telefonata
' i: macchina i-esima
' ord: posto nell'elenco delle macch. ordinate secondo il t di riattivabilit…
WHILE -1
c$ = ""
PRINT "premi A (Avvia) o E (Esci)";
WHILE NOT (c$ = "A" OR c$ = "E" OR c$ = "P")
c$ = UCASE$(INKEY$)
WEND
IF c$ = "E" THEN END
IF c$ = "P" THEN Stampo = 1 ELSE Stampo = 0
IF Stampo = 1 THEN PRINT "quando il programma sospender… la stampa, premi 'a capo' per riavviarlo"
LOCATE , 1: PRINT SPACE$(40); : LOCATE , 1
RANDOMIZE TIMER   ' RANDOMIZE 5
GOSUB Parametri: GOSUB ValoriIniziali
INPUT ; "n. linee"; linee
WHILE t < tmax
IF Stampo = 1 THEN GOSUB Stampa
SELECT CASE m(ord)
CASE 0            'la macchina riattivabile Š la 0
   GOSUB Arrivo   'arrivata la telefonata, viene generato il nuovo tempo di arrivo
   GOSUB Riposiziona
CASE ELSE         'si Š liberata la linea m(ord)
   IF O(m(ord)) = 1 THEN nc = nc - 1: O(m(ord)) = 0
   IF coda = 1 THEN 'c'Š una telefonata da inoltrare su una linea
      GOSUB Telefonata
      GOSUB Riposiziona
   ELSE
      ord = ord + 1: dt = 0: hhh$ = ""'non riattivo m(ord) e passo alla successiva macchina riattivabile
   END IF
END SELECT
GOSUB Avanza   'aggiorno gli orologi locali
WEND
AR t, t$
PRINT TAB(17); "n. di telef. arrivate, ricevute, perse:"; TAB(60); na; TAB(66); nr; TAB(72); na - nr
WEND


Parametri:
md = 48.7' durata media di una telefonata
s = 20   ' sqm durata telefonate
ma = 9   ' tempo medio tra l'arrivo di due telefonate
tmax = 18 * 60
RETURN
ValoriIniziali:
FOR i = 0 TO 20: t(i) = 0: m(i) = i: O(i) = 0: NEXT
t = 0: na = 0: nr = 0: nc = 0: coda = 0: ord = 0
RETURN

Riposiziona:
t(m(ord)) = dt: FOR i = ord + 1 TO linee
IF dt > t(m(i)) THEN SWAP m(i - 1), m(i) ELSE i = linee
NEXT
' metto nel posto giusto la macchina ord
ord = 0 'poi si andr… a cercare la macchina che libera per prima
RETURN

Telefonata:
O(m(ord)) = 1: coda = 0: NORM md, s, dt: nr = nr + 1
RETURN

Avanza:
t0 = t(m(ord)): t = t + t0
FOR i = ord TO linee: t(m(i)) = t(m(i)) - t0: NEXT
RETURN

Arrivo:
na = na + 1
IF nc < linee THEN coda = 1: nc = nc + 1
ESP ma, dt
RETURN

Stampa:
IF usato = 0 THEN
    PRINT
    IF linee > 9 THEN
        PRINT "troppe linee per la stampa"
    ELSE
        PRINT "occ.linee"; TAB(14); "dt"; TAB(19); "t"; TAB(26); "na, nr, nc"; TAB(38); "ord.liber."; TAB(51); "orologi locali"
    END IF
    usato = 1
END IF
IF dt = 0 THEN RETURN ELSE IF linee > 9 THEN RETURN
FOR i = 1 TO linee: PRINT MID$(STR$(O(i)), 2, 1); : NEXT
LOCATE , 11
AR t, t$: AR dt, dt$
PRINT dt$; hhh$; TAB(18); t$; TAB(25); na; nr; nc;
LOCATE , 38
FOR i = 0 TO linee: PRINT MID$(STR$(m(i)), 2, 1); : NEXT
LOCATE , 50
FOR i = 0 TO linee: PRINT MID$(STR$(INT(t(i) + 1 / 2)), 2); ","; : NEXT
INPUT "", xxxx$
RETURN

SUB AR (x, x$) STATIC
a = INT(x * 10 + .500000999999999#)
x$ = STR$(a): l = LEN(x$)
x$ = MID$(x$, 1, l - 1) + "." + MID$(x$, l, 1)
END SUB

SUB ESP (m, x) STATIC: SHARED hhh$, determ
hhh$ = "a"
IF determ = 1 THEN x = 9: EXIT SUB
x = -m * LOG(RND)
END SUB

SUB NORM (m, s, x) STATIC: SHARED hhh$, determ
hhh$ = "d"
IF determ = 1 THEN x = 50: EXIT SUB
IF usato = 0 THEN usato = 1: s6 = s * SQR(.6)
x = 0
FOR i = 1 TO 20
x = x + RND
NEXT
x = s6 * (x - 10) + m
IF x <= 0 THEN x = ABS(x) + 1
END SUB