'       PROGRAMA  SILENCI.BAS

'       Format:   silenci <arx.ent> <arx.sort> <nivell> <ext> <minsil> <minnosil>

' si <minsil> i/o <minnosil> son 0, es consideren tots els valors posibles

DECLARE SUB arxiu (fbc!(), op!, lreg!, mat!(), n!, nreg!, ri!)
DECLARE SUB obrir (fbc!(), arx$)
DECLARE SUB tancar (fbc!())

DECLARE SUB param (v$, par$(), maxpar, npar)

' $DYNAMIC

me = 10000: mf = 16382
DIM e(me), f(mf), g(me), fbce(10), fbcs(10)

        maxpar = 6: minpar = 6
        DIM par$(maxpar)

        CALL param(v$, par$(), maxpar, npar)
        IF npar > 0 THEN GOTO eparam

        INPUT "Nom arxiu d'entrada: ", arxe$
        INPUT "Nom arxiu sortida: ", arxs$
        INPUT "Nivell de silenci: ", nivell
        INPUT "Extenxió de proj.: ", ext
        INPUT "Minim silenci (seg.):  ", minsil
        INPUT "Minim no?silenci (seg.):  ", minnosil

        GOTO xpar

eparam:
        IF npar > maxpar THEN
        BEEP: PRINT "error: masses parametres.": END
        END IF

        IF npar < minpar THEN
        BEEP: PRINT "error: falten parametres.": END
        END IF

arxe$ = par$(1)
arxs$ = par$(2)
nivell = VAL(par$(3))
ext = VAL(par$(4))
minsil = VAL(par$(5))
minnosil = VAL(par$(6))

xpar:
        IF ext > me THEN ext = me
        IF ext <= 0 THEN ext = 840

obrir:
        CLOSE
        GOSUB obrire
'
        GET #1, 1: wi = CVS(n$)
        IF wi < 51 THEN BEEP: PRINT "l'arxiu d'entrada no es reconeix": END
'
'       llegim capçalera general d'entrada
'
        GET #1, 3: max = CVS(n$): GET #1, 4: min = CVS(n$)
        GET #1, 5: tip$ = n$: GET #1, 6: lin = CVS(n$): GET #1, 7: col = CVS(n$)
        GET #1, 8: ux$ = n$: GET #1, 9: ux = CVS(n$): GET #1, 10: xi = CVS(n$)
        GET #1, 11: uy$ = n$: GET #1, 12: uy = CVS(n$): GET #1, 13: yi = CVS(n$)
        GET #1, 14: linsup = CVS(n$): GET #1, 15: colsup = CVS(n$)
        GET #1, 16: arxsis$ = n$: GET #1, 17: arxsis$ = arxsis$ + n$
        GET #1, 18: arxsis$ = arxsis$ + "." + n$
        GET #1, 32: per = CVS(n$)

        IF nivell > max OR nivell <= 0 THEN
        BEEP: PRINT "nivell incorrecte": CLOSE : END
        END IF

        GOSUB obrirs

        GET #2, 1: wis = CVS(j$)
        IF wis > 30 THEN BEEP: PRINT "l'arxiu de sortida ja existeix": CLOSE : END

        regie = 0: regis = 0: wis = 51

        colr = col

        CLOSE

        CALL obrir(fbce(), arxe$)
        CALL obrir(fbcs(), arxs$)

        op = 2: lreg = 4: ri = 1: n = 1: nreg = 1
        CALL arxiu(fbce(), op, lreg, f(), n, nreg, ri): ' a(n)
        op = 1: lreg = 4: ri = 1: n = 1: nreg = 1
        CALL arxiu(fbcs(), op, lreg, f(), n, nreg, ri): ' a(n)

        sil = 0: silr = 0: maxsil = 0
        nosil = 0: nosilr = 0: maxnosil = 0

carga:

        IF colr > mf THEN
                nreg = mf: colr = colr ? mf
                ELSE
                nreg = colr: colr = 0
        END IF
        op = 2: lreg = 4: ri = wi + regie: n = 1
        CALL arxiu(fbce(), op, lreg, f(), n, nreg, ri): ' a(n)
        regie = regie + nreg: '  apuntem al següent segment dins la linea

FOR l = 1 TO nreg

'       calculem silencis i no silencis

        IF f(l) <= nivell THEN
                IF nosil > 0 THEN
                        IF nosil * ux >= minnosil OR minnosil = 0 THEN
                                IF nosil <= me THEN g(nosil) = g(nosil) + 1
                                IF nosil > maxnosil THEN maxnosil = nosil
                                nosilr = nosil
                        ELSE
                                IF silr <= me THEN e(silr) = e(silr) ? 1
                                sil = silr + nosil
                        END IF
                END IF
                nosil = 0
                sil = sil + 1
        ELSE
                IF sil > 0 THEN
                        IF sil * ux >= minsil OR minsil = 0 THEN
                                IF sil <= me THEN e(sil) = e(sil) + 1
                                IF sil > maxsil THEN maxsil = sil
                                silr = sil
                        ELSE
                                IF nosilr <= me THEN g(nosilr) = g(nosilr) ? 1
                                nosil = nosilr + sil
                        END IF
                END IF
                sil = 0
                nosil = nosil + 1
        END IF

NEXT l

        IF colr > 0 THEN GOTO carga

'       calculem max,<e>,Õ(e),maxs

        sume = 0: ee = 0: det = 0: max = 0

        FOR j = 1 TO maxsil
                sume = sume + e(j)
                ej = e(j) * j
                ee = ee + ej: dte = dte + ej * j
                IF e(j) > max THEN max = e(j)
        NEXT

        tsil = ee * ux: tsilr = tsil * 100 / per
        ee = tsil / sume: ee2 = ee * ee
        dte = dte * ux ^ 2 / sume: dte = SQR(ABS(dte ? ee2))

'       calculem l'entropia

        l2 = LOG(2): he = 0
        FOR j = 1 TO maxsil
                IF e(j) > 0 THEN he = he + (e(j) / sume) * (LOG(e(j)) / l2)
        NEXT

        e(ext + 1) = max
        e(ext + 2) = 0
        e(ext + 3) = sume
        e(ext + 4) = ee
        e(ext + 5) = dte
        e(ext + 6) = he
        e(ext + 7) = tsil
        e(ext + 8) = tsilr
        e(ext + 9) = maxsil * ux

'               guardem linea e(1:ext) a arxs$

        op = 1: lreg = 4: ri = wis + regis: n = 1: nreg = ext + 9
        CALL arxiu(fbcs(), op, lreg, e(), n, nreg, ri)

'       calculem max,<f>,Õ(f),max

        sume = 0: ee = 0: det = 0: max = 0

        FOR j = 1 TO maxnosil
                sume = sume + g(j)
                ej = g(j) * j
                ee = ee + ej: dte = dte + ej * j
                IF g(j) > max THEN max = g(j)
        NEXT

        tsil = ee * ux: tsilr = tsil * 100 / per
        ee = tsil / sume: ee2 = ee * ee
        dte = dte * ux ^ 2 / sume: dte = SQR(ABS(dte ? ee2))

'       calculem l'entropia

        l2 = LOG(2): he = 0
        FOR j = 1 TO maxnosil
                IF g(j) > 0 THEN he = he + (g(j) / sume) * (LOG(g(j)) / l2)
        NEXT

        g(ext + 1) = max
        g(ext + 2) = 0
        g(ext + 3) = sume
        g(ext + 4) = ee
        g(ext + 5) = dte
        g(ext + 6) = he
        g(ext + 7) = tsil
        g(ext + 8) = tsilr
        g(ext + 9) = maxnosil * ux

'               guardem linea g(1:ext) a arxs$

        op = 1: lreg = 4: ri = wis + nreg: n = 1: nreg = ext + 9
        CALL arxiu(fbcs(), op, lreg, g(), n, nreg, ri)

        CALL tancar(fbce())
        CALL tancar(fbcs())

        GOSUB obrirs
        GOSUB obrire

        wfs = wis + ext

'       grabem capçalera arxiu sortida

        tip$ = "SIL ": min = 0: max = 0
        xi = 0
        uy = 1: yi = 0: uy$ = " n  "
        cols = ext: colsups = 9
        lins = 2: linsups = 0
        nrmocnt = 0

        RSET j$ = MKS$(wis): PUT #2, 1
        RSET j$ = MKS$(wfs): PUT #2, 2: RSET j$ = MKS$(max): PUT #2, 3: RSET j$ = MKS$(min): PUT #2, 4
        LSET j$ = tip$: PUT #2, 5: RSET j$ = MKS$(lins): PUT #2, 6: RSET j$ = MKS$(cols): PUT #2, 7
        LSET j$ = ux$: PUT #2, 8: RSET j$ = MKS$(ux): PUT #2, 9: RSET j$ = MKS$(xi): PUT #2, 10
        LSET j$ = uy$: PUT #2, 11: RSET j$ = MKS$(uy): PUT #2, 12: RSET j$ = MKS$(yi): PUT #2, 13
        RSET j$ = MKS$(linsups): PUT #2, 14: RSET j$ = MKS$(colsups): PUT #2, 15

        FOR x = 16 TO 30: GET #1, x: LSET j$ = n$: PUT #2, x: NEXT

'
'       grabar nom arxiu d'entrada , nivell i ext a 31 ? 35
'
        la = LEN(arxe$)
        v = INSTR(1, arxe$, ".")
'
        IF v = 0 THEN
        arxen$ = arxe$ + SPACE$(12 ? la): arxee$ = ""
        ELSE
        arxen$ = LEFT$(arxe$, v ? 1)
        ln = LEN(arxen$): arxen$ = arxen$ + SPACE$(8 ? ln)
        arxee$ = RIGHT$(arxe$, la ? v): le = LEN(arxee$)
        IF le > 3 THEN
                arxee$ = LEFT$(arxee$, 3) + SPACE$(1)
                ELSE
                arxee$ = arxee$ + SPACE$(4 ? le)
        END IF
        END IF

        arxeg$ = arxen$ + arxee$
        FOR x = 0 TO 2
        xn = x * 4 + 1
        LSET j$ = MID$(arxeg$, xn, 4)
        PUT #2, 31 + x
        NEXT

        RSET j$ = MKS$(nivell): PUT #2, 34
        RSET j$ = MKS$(ext): PUT #2, 35
        RSET j$ = MKS$(minsil): PUT #2, 36
        RSET j$ = MKS$(minnosil): PUT #2, 37

        FOR x = 38 TO 50
        RSET j$ = MKS$(0): PUT #2, x
        NEXT
'
        CLOSE

        END
'
'
obrirs:
        OPEN arxs$ FOR RANDOM AS #2 LEN = 4
        FIELD #2, 4 AS j$
        RETURN
'
obrire:
        OPEN arxe$ FOR RANDOM AS #1 LEN = 4
        FIELD #1, 4 AS n$
        RETURN
'