' PROGRAMA GRAFIC.BAS

DECLARE SUB fixer ()

DECLARE SUB temps (t!, th!, tm!, ts!)
DECLARE SUB arxiuh (numarx!, op!, lreg!, mat!(), n!, nreg!, ri!)

TYPE pilaarxius
        arx AS STRING * 12
        liact AS INTEGER
        inc AS INTEGER
        segact AS INTEGER
        reginipan AS INTEGER
        marca AS INTEGER
        cxm AS INTEGER
        ix AS INTEGER
        cym AS SINGLE
        iy AS SINGLE
        est AS INTEGER
        rec AS INTEGER
        multx AS SINGLE
        escy AS INTEGER
        xii AS SINGLE
        maxr AS SINGLE
        minr AS SINGLE
END TYPE

' $DYNAMIC

inici:

maxpar = 2: dima = 14000
DIM SHARED a(dima), par$(maxpar), ea(dima), p(2000)
DIM SHARED pila(20) AS pilaarxius

DIM SHARED col, lin, ux, xi, ux$, uy, yi, uy$, wi, max, min, tip$
DIM SHARED nreg.seg

LF$ = CHR$(13)

cami$ = ENVIRON$("INV")
IF cami$ = "" THEN cami$ = "c:\inv"

' ========================================================================
'                       CARGA  LA  PILA
' ========================================================================

' primer mirem si tenim una pila en el directori de treball
' i si hi es, cargem la pila

OPEN "grafic.pil" FOR RANDOM AS #3 LEN = LEN(pila(0))
GET #3, 1, pila(1)
IF pila(1).liact < 1 THEN
        pila(1).liact = 1
        ELSE
        FOR x = 2 TO pila(1).liact: GET #3, x, pila(x): NEXT
END IF
CLOSE #3

' ========================================================================
'                       ENTRA PARAMETRES
' ========================================================================

' mirem si s'ha entrat algun parametre
' si ni ha, anem a obrir l'arxiu entrat

arx$ = COMMAND$
IF arx$ <> "" THEN GOTO obre

' si no hi ha parametres i tenim pila, obrim l'arxiu actiu de la pila

IF pila(1).inc > 1 THEN fich = pila(1).inc: GOTO nouarx

' ========================================================================
'                       MENU  DE  LA  PILA
' ========================================================================

mostrapila:

SCREEN 0: CLS
IF pila(1).liact = 1 THEN GOTO entra

PRINT "Pila:": PRINT
fich = 0

FOR x = 2 TO pila(1).liact
        PRINT USING "##) &"; x ? 1; pila(x).arx
NEXT

PRINT
PRINT "Entra número de fixer:  ";
f = VAL(INPUT$(1))
IF f = 0 THEN GOTO entra
IF f > pila(1).liact ? 1 THEN GOTO mostrapila
fich = f + 1

nouarx:

arx$ = RTRIM$(pila(fich).arx)
GOTO obre

' ========================================================================
'                       MENU  ENTRAR  ARXIU
' ========================================================================

entra:

KEY ON
KEY 1, "DIRECTORI" + LF$: KEY 3, "BOR.PILA" + LF$
KEY 4, "GRAFACP" + LF$: KEY 10, "SORTIR" + LF$

ent1:

PRINT : PRINT
IF pat$ = "" THEN FILES ELSE FILES pat$

INPUT "entra nom arxiu  ", arx$
IF arx$ = "SORTIR" THEN KEY OFF: GOTO mostrapila
IF arx$ = "GRAFACP" THEN CLOSE : RUN cami$ + "\grafacp"
IF arx$ = "DIRECTORI" THEN GOTO dir
IF arx$ = "BOR.PILA" THEN KILL "grafic.pil": GOTO entra
IF arx$ = "" THEN GOTO ent1

KEY OFF: GOTO obre

dir:

PRINT
INPUT "entra patró  ", pat$
GOTO entra

' ========================================================================
'                            OBRIR  L'ARXIU
' ========================================================================

obre:
       

larx = LEN(arx$)
IF larx > 12 THEN GOTO entra
arx$ = UCASE$(arx$)

GOSUB obrir

GET #1, 1: wi = CVS(n$)
IF wi < 31 THEN
        PRINT "l'arxiu no es reconeix": PRINT
        END
END IF

' ========================================================================
'                LLEGIM LA CAPÇALERA GENERAL DEL ARXIU
' ========================================================================

GET #1, 2: wf = CVS(n$): 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, 19: nrmocnt = CVS(n$)
GET #1, 20: dia = CVS(n$): GET #1, 21: mes = CVS(n$): GET #1, 22: aa = CVS(n$)
GET #1, 23: hora = CVS(n$)
GET #1, 24: horac = CVS(n$): 'hora de referencia de la cinta
IF horac < 0 THEN horac = 2 ^ 16 + hora

CALL temps(horac, hhc, hmc, hsc)
CALL temps(hora, hha, hma, hsa)

IF ux = 0 THEN ux = 1: ux$ = "u."

' salvem les unitats del eix x per conmutar a unitats columna
uxr = ux: xir = xi: uxr$ = ux$
coor.x.ini.linea = xi

nlin = lin + linsup: ' número total de linees

IF nlin = 1 AND max = 0 AND min = 0 THEN PRINT "arxiu no grafic": END

' ========================================================================
'           DETERMINEM  VALORS  INICIALS  PEL  ARXIU
' ========================================================================

lliure$ = STRING$(4, 255)

Punts.Pan.X.Pos = 600: punts.pan.x.neg = ?39
maxpuntsypos = 156: maxpuntsyneg = ?43

pas = 0: ' conmutador per agafar els valors inicials de la pila

IF fich > 0 AND pas = 0 THEN
        multx = pila(fich).multx
        coor.x.ini.linea = pila(fich).xii
        li.act = pila(fich).liact
        marca = pila(fich).marca
        cxm = pila(fich).cxm
        ix = pila(fich).ix
        iy = pila(fich).iy
        est = pila(fich).est
        inc = pila(fich).inc
        reg.ini.pan.act = pila(fich).reginipan
ELSE
        multx = 1
        li.act = 1
        marca = 0
        escy = 0
        rec = 0
        reg.ini.pan.act = 0
        inc = 400
END IF

li.ant = 0

' ========================================================================
'            CALCULEM EL NUMERO DE SEGMENTS DE LA LINEA
' ========================================================================

nseg = 0
colr = col

WHILE colr ? 200 > 0
    nseg = nseg + 1
    colr = colr ? dima + 200
WEND
  

IF nseg = 0 THEN nseg = 1
IF fich > 0 AND pas = 0 THEN
    seg.act = pila(fich).segact
ELSE
    seg.act = 1
END IF

seg.ant = 0

' calculem el num. de regs. del segment
IF col ? reg.ini.seg > dima THEN
    nreg.seg = dima
ELSE
    nreg.seg = col ? reg.ini.seg
END IF

IF nlin = 1 THEN wlin = wi: GOTO escalaxy

' ========================================================================
'                LLEGIM ELS VALORS DE LA NOVA LINEA
' ========================================================================

novalinea:

' comprobem la linea demanada
IF li.act < 1 THEN li.act = 1
IF li.act > nlin THEN li.act = nlin
IF li.act = li.ant THEN GOTO ordre
       

wlin = wi + (li.act ? 1) * (col + colsup)

GET #1, wlin + col: max = CVS(n$)
GET #1, wlin + col + 1: min = CVS(n$)
       

IF tip$ = "PARL" OR tip$ = "SRES" THEN
        GET #1, wlin + col + 3: ux$ = n$
        GET #1, wlin + col + 4: ux = CVS(n$)
        GET #1, wlin + col + 5: coor.x.ini.linea = CVS(n$)
        GET #1, wlin + col + 6: uy$ = n$
        GET #1, wlin + col + 7: uy = CVS(n$)
        GET #1, wlin + col + 8: yi = CVS(n$)
END IF
       

GOSUB tipusarxiu
       

' si la linea no es grafica, camviem de linea
IF max = 0 AND min = 0 THEN
        li.ant = li.act
        IF a <> 73 AND a <> 81 THEN li.act = li.act + 1: GOTO novalinea
        IF li.act = nlin THEN a = 73: li.act = li.act ? 1: GOTO novalinea
        IF li.act = 1 THEN a = 81: li.act = li.act + 1: GOTO novalinea
        IF a = 73 THEN li.act = li.act ? 1: GOTO novalinea
        IF a = 81 THEN li.act = li.act + 1: GOTO novalinea
        CLS : PRINT "Linea no grafica"
        li.act = 0: GOTO linea
END IF

' ========================================================================
'             DETERMINEM  PARAMETRES DELS EIXOS  X  i  Y
' ========================================================================

escalaxy:

' calculem els parametres de l'escala del eix x
GOSUB escalax
       

' calculem els parametres de l'escala del eix y
IF fich > 0 AND pas = 0 THEN
    maxr = pila(fich).maxr
    minr = pila(fich).minr
    GOSUB escalay
    cym = pila(fich).cym
ELSE
    maxr = max
    minr = min
    GOSUB escalay
    cym = ycero
END IF

' ========================================================================
'                     CARGEM EL SEGMENT DEMANAT
' ========================================================================

carga:

' comprobem el segment demanat
IF seg.act < 1 THEN seg.act = 1
IF seg.act > nseg THEN seg.act = nseg
IF li.act = li.ant THEN
    IF seg.act = seg.ant THEN GOTO ordre
END IF

' calculem el reg. inicial del segment
reg.ini.seg = (seg.act ? 1) * (dima ? 200)

' calculem el num. de regs. del segment
IF col ? reg.ini.seg > dima THEN
    nreg.seg = dima
ELSE
    nreg.seg = col ? reg.ini.seg
END IF

' cargem el segment
op = 2: lreg = 4: ri = wlin + reg.ini.seg: n = 1
CALL arxiuh(1, op, lreg, a(), n, nreg.seg, ri): ' a(n)

' si cambiem de segment d'una mateixa linea
' inicialitzem reg.ini.pan
IF li.act = li.ant THEN
    IF seg.act > seg.ant THEN
        reg.ini.pan.act = 0
    ELSE
        reg.ini.pan.act = nreg.seg
    END IF
    reg.ini.pan.ant = ?1
END IF

' ========================================================================
'                    DIBUIXAR  LA  PANTALLA
' ========================================================================

dibuix:
       

' calculem nreg.pan
nreg.pan = INT((Punts.Pan.X.Pos + 1) / multx)
IF nreg.pan > nreg.seg THEN
    nreg.pan = nreg.seg
END IF

' comprobem la pantalla a dibuixar
IF reg.ini.pan.act < 0 THEN reg.ini.pan.act = 0
IF reg.ini.pan.act > nreg.seg ? nreg.pan THEN
    reg.ini.pan.act = nreg.seg ? nreg.pan
END IF

dibuix1:

' calculem el punter final de la pantalla  reg.fin.pan
reg.fin.pan = reg.ini.pan.act + nreg.pan
IF reg.fin.pan > nreg.seg THEN reg.fin.pan = nreg.seg

' inhabilitem la carga de parametres de la pila
pas = 1

' actualitzem els valors de referencia
seg.ant = seg.act
li.ant = li.act
reg.ini.pan.ant = reg.ini.pan.act

IF rec = 0 THEN CLS
SCREEN 2

' presentar estadistica de la linea si es demana
IF est = 1 THEN GOSUB estad

' dibuixem les linees y les marques dels eixos x e y
GOSUB dibuixaeixos

dibuix2:

WINDOW (Punts.Pan.X.Pos, cya)?(punts.pan.x.neg, cyb)

IF rec = 0 THEN
    IF max < panymax THEN
        LINE (?18, max)?(?10, max)
        LOCATE 3, 1: PRINT USING "##.#^^^^"; max
    END IF
    IF min > panymin THEN
        LINE (?18, min)?(?10, min)
        IF min <> 0 THEN
            LOCATE 18, 1: PRINT USING "##.#^^^^"; min
        ELSE
            LOCATE 19, 2: PRINT "0"
        END IF
    END IF
    ' dibuixem la linea del 0
    IF ycero > panymin AND ycero <= panymax THEN
        LINE (0, ycero)?(nreg.pan * multx, ycero), , , &H9249
    END IF
END IF

' dibuixem la linea puntejada fins el primer valor de la pantalla
IF a(reg.ini.pan.act + 1) > panymax THEN
    a = panymax
ELSE
    IF a(reg.ini.pan.act + 1) < panymin THEN
        a = panymin
    ELSE
        a = a(reg.ini.pan.act + 1)
    END IF
END IF
IF ycero > panymin AND ycero < panymax THEN
    LINE (0, ycero)?(0, a), , , &HCCCC
ELSE
    PSET (0, a)
END IF

' dibuixem la pantalla
x = multx
FOR l = reg.ini.pan.act + 2 TO reg.fin.pan ? 1
        SELECT CASE calcul
                CASE 3
                        a = LOG(a(l))
                CASE ELSE
                        a = a(l)
        END SELECT

        IF a > panymax THEN
            a = panymax
        ELSE
            IF a < panymin THEN
                a = panymin
            END IF
        END IF
        IF rec = 1 THEN s% = &HAAAA ELSE s% = &HFFFF
        LINE ?(x, a), , , s%
        x = x + multx
        a$ = INKEY$
        IF a$ <> "" THEN GOTO ordre1
NEXT

' dibuixem la linea puntejada fins el ultim valor de la pantalla
IF MKS$(a(reg.fin.pan)) = lliure$ THEN
        x = x ? multx
ELSE
        IF a(reg.fin.pan) > panymax THEN
            a = panymax
        ELSE
            IF a(reg.fin.pan) < panymin THEN
                a = panymin
            ELSE
                a = a(reg.fin.pan)
            END IF
        END IF
        LINE ?(x, a)
END IF
IF ycero < panymax AND ycero >= panymin THEN
    LINE (x, a)?(x, ycero), , , &HCCCC
END IF

' si marca x es activa, dibuixa marca x
IF marca = 1 THEN
        cyar = panymax
        cybr = cyb + 36 * (cya ? cyb) / 200
        ' resituem la marca per si es cambia el multx
        IF multx > 1 THEN
            cxm = cxm ? cxm MOD multx
        END IF
        GET (cxm, cyar)?(cxm, cybr), p(0)
        LINE (cxm, cyar)?(cxm, cybr)
END IF

' si marca y es activa, dibuixa marca y
IF marca = 2 THEN
        FOR x = 0 TO nreg.pan * multx STEP 8: PSET (x, cym): NEXT
        GET (0, cym)?(Punts.Pan.X.Pos, cym), p(1000)
END IF

' ========================================================================
'                          ORDRES
' ========================================================================

ordre:

LOCATE 1, 50: PRINT SPACE$(31);
GOSUB mens

ordre0:

a$ = INKEY$
IF LEN(a$) = 0 THEN GOTO ordre0

ordre1:

IF LEN(a$) = 2 THEN
        a$ = RIGHT$(a$, 1)
        a = ASC(a$)
       

        ' desplaçar la pantalla
        IF a = 71 THEN reg.ini.pan.act = 0: GOTO xecpan
        IF a = 75 THEN
            reg.ini.pan.act = reg.ini.pan.act ? INT(inc / multx)
            GOTO xecpan
        END IF
        IF a = 77 THEN
            reg.ini.pan.act = reg.ini.pan.act + INT(inc / multx)
            GOTO xecpan
        END IF
        IF a = 79 THEN reg.ini.pan.act = nreg.seg: GOTO xecpan
       

        ' ampliar/reduir l'escala del eix y
        IF a = 72 THEN
            maxr = cym + (maxr ? cym) / 2
            minr = cym + (minr ? cym) / 2
            GOSUB escalay
            iy = iy / 2
            GOTO dibuix1
        END IF
        IF a = 80 THEN
            maxr = cym + (maxr ? cym) * 2
            minr = cym + (minr ? cym) * 2
            GOSUB escalay
            iy = iy * 2
            GOTO dibuix1
        END IF
        IF a = 83 THEN
                IF maxr = max THEN GOTO ordre
                maxr = max: minr = min
                GOSUB escalay
                iy = UniY * 8
                GOTO dibuix1
        END IF

        ' si cambi de segment
        IF a = 115 THEN seg.act = seg.act ? 1: GOTO carga
        IF a = 116 THEN seg.act = seg.act + 1: GOTO carga
        IF a = 117 THEN seg.act = nseg: GOTO carga
        IF a = 119 THEN seg.act = 1: GOTO carga
       

        ' si cambi de linea
        IF a = 118 THEN li.act = lin: GOTO novalinea
        IF a = 132 THEN li.act = 1: GOTO novalinea
        IF a = 73 THEN li.act = li.act ? 1: GOTO novalinea
        IF a = 81 THEN li.act = li.act + 1: GOTO novalinea

        ' ALT + 1, 2, ...   cambi de arxiu de la pila
        va = a ? 119 + 1
        IF va > 1 AND va <= pila(1).liact THEN
                IF va = fich THEN GOTO ordre
                    GOSUB posapila
                    fich = va
                    GOTO nouarx
                END IF
        END IF

a = ASC(a$)
IF a = 27 THEN CLOSE : GOSUB posapila: END
IF a$ = "a" OR a$ = "A" THEN GOSUB ajut: GOTO dibuix1
IF a$ = "v" OR a$ = "V" THEN GOSUB veure: GOTO dibuix1
IF a$ = "s" OR a$ = "S" THEN GOSUB segment: GOTO carga
IF a$ = "d" OR a$ = "D" THEN GOTO despla
IF a$ = "l" OR a$ = "L" THEN GOTO linea
IF a$ = "f" OR a$ = "F" THEN
    fixer
    GOTO ordre
END IF
IF a$ = "e" OR a$ = "E" THEN
        IF est = 1 THEN est = 0: GOTO dibuix1 ELSE est = 1: GOSUB estad
        GOTO ordre
        END IF
IF a$ = "r" OR a$ = "R" THEN
        IF rec = 0 THEN rec = 1 ELSE rec = 0
        IF rec = 0 THEN panr = pan ? 1: GOTO dibuix
        GOTO ordre
END IF

IF a$ = "m" OR a$ = "M" THEN GOTO marca
IF a$ = "p" OR a$ = "P" THEN
    GOSUB posapila
    GOTO mostrapila
END IF
IF a$ = "c" OR a$ = "C" THEN GOTO calcul
IF a$ = "o" OR a$ = "O" THEN GOTO origen
IF a$ = "x" OR a$ = "X" THEN GOTO multiplicax
IF a$ = "y" OR a$ = "Y" THEN
        IF escy = 0 THEN escy = 1 ELSE escy = 0
        IF escy = 0 THEN panr = pan ? 1: GOSUB escalay: GOTO dibuix1
        GOTO ordre
END IF

        IF a = 46 THEN
                ix = ix / 2
                IF ix < multx THEN ix = multx
                iy = iy / 2
                IF iy <= UniY THEN iy = UniY
                GOTO ordre
                END IF
        IF a = 48 THEN
                ix = ix * 2
                iy = iy * 2: GOTO ordre
                END IF

        GOSUB borcent
        IF a = 52 THEN cxm = cxm ? ix: GOSUB dibcent: GOTO ordre
        IF a = 54 THEN cxm = cxm + ix: GOSUB dibcent: GOTO ordre
        IF a = 56 THEN cym = cym + iy: GOSUB dibcent: GOTO ordre
        IF a = 50 THEN cym = cym ? iy: GOSUB dibcent: GOTO ordre

sort:

LOCATE 24, 1: PRINT SPACE$(78);
LOCATE 24, 1: PRINT "vols sortir?  (S/N)  ";

sort1:
s$ = INKEY$
IF s$ = "s" OR s$ = "S" THEN
        CLOSE
        CLS : SCREEN 0: fich = 0
        GOTO entra
END IF

IF s$ = "n" OR s$ = "N" THEN
        LOCATE 24, 1: PRINT SPACE$(78); : GOTO ordre
END IF

GOTO sort1

mens:
        LOCATE 1, 7: PRINT SPACE$(72);
        IF fich = 0 THEN f = 0 ELSE f = fich ? 1
        LOCATE 1, 7: PRINT USING "& [#]  ##:##:## &"; arx$; f; hhc; hmc; hsc; tipa$
        IF escy = 1 THEN LOCATE 1, 79: PRINT "Y";
        IF rec = 1 THEN LOCATE 1, 80: PRINT "R";

        IF marca = 1 THEN
                LOCATE 24, 28
                cxv = coor.x.ini.pan + cxm / multx * ux
                PRINT "[X:";
                IF ux$ = "seg." AND ux > .02 THEN
                        CALL temps(cxv, cxvh, cxvm, cxvs)
                        PRINT USING "#:##:##.###   Y:"; cxvh; cxvm; cxvs;
                        ELSE
                        PRINT USING "##.####^^^^   Y:"; cxv;
                        END IF
                PRINT USING "##.##^^^^^]"; a(reg.ini.pan.act + cxm / multx + 1);
        END IF

        IF marca = 2 THEN
                LOCATE 24, 28
                PRINT USING "[Y: ##.##^^^^^]"; cym;
                END IF

        LOCATE 24, 1
        PRINT "L:"; li.act; "/"; nlin; "  S:"; seg.act; "/"; nseg;
        LOCATE 24, 65: PRINT "<A> : Ajut";
        RETURN
'
linea:
        LOCATE 1, 50: PRINT SPACE$(26);
        LOCATE 1, 50: INPUT "Entra linea : ", li: 'li.ant
        IF li.act <> li THEN li.act = li ELSE GOTO ordre
        GOTO novalinea

unit:
        IF uxa = 0 THEN uxa = ux: ux = ux / 60: RETURN
        SWAP uxa, ux
        RETURN
'
ajut:
        CLS
        PRINT " <???  :  pàgina esquerra                Home : pàgina 1"
        PRINT " ???>  :  pàgina dreta                   End  : última pàgina"
        PRINT
        PRINT " Ctrl + <???  :  segment esquerra        Ctrl + Home : segment 1"
        PRINT " Ctrl + ???>  :  segment dret            Ctrl + End  : últim segment"
        PRINT
        PRINT " amunt :  amplia la funció               avall :  redueix la funció"
        PRINT
        PRINT " Del   :  restaura el tamany original de la funció"
        PRINT
        PRINT " PgUp  :  linea anterior                 Ctrl + PgUp : linea 1"
        PRINT " PgDn  :  linea posterior                Ctrl + PgDn : última linea"
        PRINT
        PRINT " A :  pàgina d'Ajuda                     L :  saltar a Linea"
        PRINT " P :  mostra pila                        S :  saltar a Segment"
        PRINT " D :  Desplaçament de pàgina             V :  Veure arxiu"
        PRINT " E :  Estadistica                        R :  Recobriment"
        PRINT " M :  Marca (X/Y)                        C :  Calcul"
        PRINT " X :  escala X (c: cambia a uni. col)    Y :  escala Y fixe/dinamica"
        PRINT " Shift + dreta/esquerra: moure marca X   F :  exportar a Fixer"
        PRINT " Shift + amunt/avall: moure marca Y      Shift + ins/del : +/? salta marca"
        PRINT " Alt + 1, 2,..: cambiar a arxiu pila     Esc: tornar al DOS"
        PRINT " qualsevol altra tecla per sortir a nou arxiu"

ajut1:
        IF INKEY$ = "" THEN GOTO ajut1
        rec = 0
        RETURN

segment:
        LOCATE 1, 50: INPUT "Número de segment:  ", isg
        seg.ant = seg.act
        IF isg > 0 AND isg <= nseg THEN seg.act = isg
        GOSUB mens
        RETURN

despla:
        LOCATE 1, 50: INPUT "Desplaçament de pàgina:  ", i
        GOSUB mens
        IF i > 0 THEN inc = i
        IF inc > nreg.pan THEN GOTO despla
        GOTO ordre

multiplicax:
        LOCATE 1, 50: PRINT USING "mult. eix X: [###.##]"; multx
        LOCATE 1, 73: INPUT "", i$
        IF i$ = "c" OR i$ = "C" THEN
            IF ux = uxr THEN ux = 1: xi = 0: ux$ = "col." ELSE ux = uxr: xi = xir: ux$ = uxr$
        ELSE
            mulx = VAL(i$)
            IF mulx <= 0 OR mulx = multx THEN GOTO ordre
            ix = INT(mulx * ix / multx)
            multx = mulx
        END IF
        GOSUB escalax: GOTO dibuix

estad:
        li$ = STR$(li.act)
        LOCATE 3, 56
        GOSUB estadist
        RETURN

'       Procediment veure

veure:
        SCREEN 0
        PRINT "ARXIU:  "; arx$: PRINT : PRINT
        SHELL "veure " + arx$
veur1:
        IF INKEY$ = "" THEN GOTO veur1
        SCREEN 2
        rec = 0
        RETURN
'
obrir:
        CLOSE #1
        OPEN arx$ FOR RANDOM AS #1 LEN = 4
        FIELD #1, 4 AS n$
        RETURN

marca:
        LOCATE 1, 50: PRINT SPACE$(30);
        LOCATE 1, 50: INPUT "Marca  X / Y : ", m$
        IF m$ = "y" OR m$ = "Y" THEN marca = 2: GOSUB centre: GOTO ordre
        IF m$ = "x" OR m$ = "X" THEN marca = 1: GOSUB centre: GOTO ordre
        marca = 0
        GOTO ordre

origen:
        IF ux$ = "seg." AND ux > .02 THEN
            LOCATE 1, 50: INPUT "Entra origen (h:m.s) ", tmp$
            GOSUB det.temps
        ELSE
            LOCATE 1, 50: INPUT "Entra origen X :  ", tmp$
            tmp = VAL(tmp$)
        END IF
        IF tmp$ <> "" THEN
            coor.x.ini.linea = tmp
            GOSUB escalax
        END IF
        GOTO dibuix

det.temps:

lt = LEN(tmp$)
ps = INSTR(tmp$, "?")
IF ps > 0 THEN
        sig = ?1
        tmp$ = RIGHT$(tmp$, lt ? ps)
        ELSE
        sig = 1
        END IF

lt = LEN(tmp$)
ph = INSTR(tmp$, ":")

IF ph > 0 THEN
        hora = VAL(LEFT$(tmp$, ph ? 1))
        tmp$ = RIGHT$(tmp$, lt ? ph)
        ELSE
        hora = 0
        END IF

lt = LEN(tmp$)
pm = INSTR(tmp$, ".")

IF pm > 0 THEN
        min = VAL(LEFT$(tmp$, pm ? 1))
        tmp$ = RIGHT$(tmp$, lt ? pm)
        ELSE
        min = 0
        END IF

segons = VAL(tmp$)

tmp = (hora * 3600 + min * 60 + segons) * sig

RETURN

'**************************************************************************
'                 SUBRUTINA   estadist
'**************************************************************************

estadist:

l1 = CSRLIN: c1 = POS(0)

IF tip$ = "STII" OR tip$ = "STI " OR tip$ = "STI2" THEN GOTO sti
IF tip$ = "DCB " THEN GOTO dcb
IF tip$ = "STD " THEN GOTO std
IF tip$ = "COV " THEN GOTO cov
IF tip$ = "SESP" OR tip$ = "<ES>" THEN GOTO sesp
IF tip$ = "DENY" THEN GOTO dny
IF tip$ = "SIL " THEN GOTO sil
IF tip$ = "PARL" THEN GOTO parl
IF tip$ = "DIST" THEN GOTO dist
IF tip$ = "DIAG" THEN GOTO diag
IF tip$ = "SRES" THEN GOTO sres

est = 0
RETURN

sti:

GET #1, 31: minta = CVS(n$): GET #1, 32: per = CVS(n$): GET #1, 33: uf$ = n$
GET #1, 34: frm = CVS(n$): GET #1, 35: fri = CVS(n$): GET #1, 36: et = CVS(n$)
GET #1, 37: vt = CVS(n$): GET #1, 38: ee = CVS(n$): GET #1, 39: ve = CVS(n$)
GET #1, 40: te = CVS(n$)
GET #1, 41: tesp = CVS(n$)

etr = et / per * 100

temps et, eth, etm, ets
temps vt, vth, vtm, vts
temps per, peh, pem, pes
temps tesp, teh, tem, tes

LOCATE l1, c1
PRINT USING " õE   = ##.##^^^^ &"; te; uy$
LOCATE l1 + 1, c1
PRINT USING " <E>  = ##.##^^^^ &"; ee; uy$
LOCATE l1 + 2, c1
PRINT USING "Õ(E)? = ##.##^^^^ &"; ve; uy$
LOCATE l1 + 3, c1
PRINT USING "  T   = #:##:##.###"; peh; pem; pes
LOCATE l1 + 4, c1
PRINT USING " <t>  = #:##:##.###"; eth; etm; ets
LOCATE l1 + 5, c1
PRINT USING " <t>r =     ##.# %"; etr
LOCATE l1 + 6, c1
PRINT USING "Õ(t)? = #:##:##.###"; vth; vtm; vts
LOCATE l1 + 7, c1
PRINT USING " tesp = #:##:##"; teh; tem; tes

RETURN

std:

GET #1, 31: per = CVS(n$): GET #1, 32: uf$ = n$
GET #1, 33: frm = CVS(n$): GET #1, 34: ee = CVS(n$)
GET #1, 35: ve = CVS(n$): GET #1, 36: te = CVS(n$)
GET #1, 41: frf = CVS(n$): IF frf < 0 THEN tf$ = "PA " ELSE tf$ = "PB "

LOCATE l1, c1
PRINT USING " õE   = ##.####^^^^ &"; te; uy$
LOCATE l1 + 1, c1
PRINT USING " <E>  = ##.####^^^^ &"; ee; uy$
LOCATE l1 + 2, c1
PRINT USING "Õ(E)? = ##.####^^^^ &"; ve; uy$
IF frf <> 0 THEN
LOCATE l1 + 3, c1
PRINT USING " & = ###.## Hz."; tf$; frf
END IF

RETURN

dcb:

GET #1, 34: et = CVS(n$): GET #1, 35: vt = CVS(n$)
GET #1, 36: ee = CVS(n$): GET #1, 37: ve = CVS(n$)
GET #1, 38: te = CVS(n$)

per = col * ux
etr = et / per * 100

temps et, eth, etm, ets
temps vt, vth, vtm, vts
temps per, peh, pem, pes

LOCATE l1, c1
PRINT USING " õDb  = ##.####^^^^ &"; te; uy$
LOCATE l1 + 1, c1
PRINT USING " <Db> = ##.####^^^^ &"; ee; uy$
LOCATE l1 + 2, c1
PRINT USING "Õ(Db)?= ##.####^^^^ &"; ve; uy$
LOCATE l1 + 3, c1
PRINT USING "  T   = #:##:##.###"; peh; pem; pes
LOCATE l1 + 4, c1
PRINT USING " <t>  = #:##:##.###"; eth; etm; ets
LOCATE l1 + 5, c1
PRINT USING " <t>r =     ##.# %"; etr
LOCATE l1 + 6, c1
PRINT USING "Õ(t)? = #:##:##.###"; vth; vtm; vts

RETURN

cov:

GET #1, 31: arxe$ = n$: GET #1, 32: arxe$ = arxe$ + n$: GET #1, 33: arxe$ = arxe$ + "." + n$
GET #1, 34: vari = CVS(n$): GET #1, 35: nvar = CVS(n$)
GET #1, 36: indi = CVS(n$): GET #1, 37: nind = CVS(n$)
GET #1, 38: tra = CVS(n$)

RETURN

sesp:

GET #1, 34: segm = CVS(n$): GET #1, 35: desp = CVS(n$)
GET #1, 38: inici = CVS(n$)
GET #1, 42: uxt$ = n$: GET #1, 43: uxt = CVS(n$)
ti = inici ? 1 + (li.act ? 1) * desp: tf = ti + segm
ti = ti * uxt: tf = tf * uxt

temps ti, tih, tim, tis
temps tf, tfh, tfm, tfs

ri = wi + (li.act ? 1) * (col + colsup) + col
GET #1, ri: maxl = CVS(n$)
GET #1, ri + 2: x0 = CVS(n$)
GET #1, ri + 3: sum = CVS(n$)
GET #1, ri + 4: ef = CVS(n$)
GET #1, ri + 5: dtf = CVS(n$)
GET #1, ri + 6: hf = CVS(n$)
GET #1, ri + 7: tote = CVS(n$)

GET #1, 40: uh$ = n$: GET #1, 41: hmf = CVS(n$)

LOCATE l1, c1
PRINT USING " X(0) = ##.####^^^^ &"; x0; uy$
LOCATE l1 + 1, c1
PRINT USING " õf   = ##.####^^^^ &"; sum; uy$
LOCATE l1 + 2, c1
PRINT USING " <f>  = ##.####^^^^ &"; ef; ux$
LOCATE l1 + 3, c1
PRINT USING "Õ(f)  = ##.####^^^^ &"; dtf; ux$
LOCATE l1 + 4, c1
PRINT USING " H(f) =  ##.#### &"; hf; uh$
LOCATE l1 + 5, c1
PRINT USING " Hmax =  ##.#### &"; hmf; uh$
IF li.act > lin THEN RETURN
LOCATE l1 + 6, c1
PRINT USING " õE   = ##.##^^^^"; tote
LOCATE l1 + 7, c1 ? 1
PRINT USING "#:##:##.## a #:##:##.##"; tih; tim; tis; tfh; tfm; tfs

RETURN

dny:

ri = wi + (li.act ? 1) * (col + colsup) + col
GET #1, ri + 2: sume = CVS(n$)
GET #1, ri + 3: ee = CVS(n$)
GET #1, ri + 4: dte = CVS(n$)
GET #1, ri + 5: he = CVS(n$)

GET #1, 38: uh$ = n$
'GET #1, 39: he = CVS(n$)

LOCATE l1, c1
PRINT USING " õn   = ###,###"; sume
LOCATE l1 + 1, c1
PRINT USING " <x>  = ##.####^^^^ &"; ee; ux$
LOCATE l1 + 2, c1
PRINT USING "Õ(x)? = ##.####^^^^ &"; dte; ux$
LOCATE l1 + 3, c1
PRINT USING " H(x) =  ##.#### &"; he; uh$

RETURN

sil:

GET #1, 34: niv = CVS(n$)
GET #1, 36: minsil = CVS(n$)
GET #1, 37: minnosil = CVS(n$)

ri = wi + (li.act ? 1) * (col + colsup) + col

GET #1, ri + 2: sume = CVS(n$)
GET #1, ri + 3: et = CVS(n$)
GET #1, ri + 4: dtt = CVS(n$)
GET #1, ri + 5: uh$ = n$
GET #1, ri + 6: tsil = CVS(n$)
GET #1, ri + 7: tsilr = CVS(n$)
GET #1, ri + 8: maxsil = CVS(n$)

temps et, eth, etm, ets
temps dtt, dth, dtm, dts
temps tsil, tsh, tsm, tss
temps maxsil, msh, msm, mss

LOCATE l1, c1
PRINT USING " õn   = ###,###"; sume
LOCATE l1 + 1, c1
PRINT USING " <t>  = #:##:##.###"; eth; etm; ets
LOCATE l1 + 2, c1
PRINT USING "Õ(t)? = #:##:##.###"; dth; dtm; dts
LOCATE l1 + 3, c1
PRINT USING " maxt = #:##:##.###"; msh; msm; mss
LOCATE l1 + 4, c1
PRINT USING " õ t  = #:##:##.###"; tsh; tsm; tss
LOCATE l1 + 5, c1
PRINT USING " % t  = ###.##"; tsilr
LOCATE l1 + 6, c1
PRINT USING " Niv. = ##.####^^^^"; niv
LOCATE l1 + 7, c1
PRINT USING "Min.sil   = ##.## seg."; minsil
LOCATE l1 + 8, c1
PRINT USING "Min.nosil = ##.## seg."; minnosil

RETURN

parl:
        ri = wi + (li.act ? 1) * (col + colsup) + col
        GET #1, ri + 2: etp = CVS(n$)
        GET #1, ri + 3: dttp = CVS(n$)
        GET #1, ri + 4: ep = CVS(n$)
        GET #1, ri + 5: dtp = CVS(n$)

        temps etp, eph, epm, eps
        temps dttp, dtph, dtpm, dtps

        LOCATE l1, c1
        PRINT USING " <t>  = #:##:##.###"; eph; epm; eps
        LOCATE l1 + 1, c1
        PRINT USING "Õ(t)? = #:##:##.###"; dtph; dtpm; dtps
        LOCATE l1 + 2, c1
        PRINT USING " <y>  = ##.####^^^^ &"; ep; uy$
        LOCATE l1 + 3, c1
        PRINT USING "Õ(y)? = ##.####^^^^ &"; dtp; uy$

        RETURN

dist:

GET #1, 34: sumd = CVS(n$): GET #1, 35: ed = CVS(n$)
GET #1, 36: vd = CVS(n$): GET #1, 37: et = CVS(n$)
GET #1, 38: vt = CVS(n$)

per = 2 * coor.x.ini.linea + (col ? 1) * ux
etr = 100 * et / per: vtr = 100 * vt / per

temps et, eth, etm, ets
temps vt, vth, vtm, vts

LOCATE l1, c1
PRINT USING " õd   = ##.####^^^^ &"; sumd; uy$
LOCATE l1 + 1, c1
PRINT USING " <d>  = ##.####^^^^ &"; ed; uy$
LOCATE l1 + 2, c1
PRINT USING "Õ(d)? = ##.####^^^^ &"; vd; uy$
LOCATE l1 + 3, c1
PRINT USING " <t>r  = ##.# %"; etr
LOCATE l1 + 4, c1
PRINT USING "Õ(t)?r = ##.# %"; vtr
LOCATE l1 + 5, c1
PRINT USING " <t>  = #:##:##.###"; eth; etm; ets
LOCATE l1 + 6, c1
PRINT USING "Õ(t)? = #:##:##.###"; vth; vtm; vts

RETURN

diag:

GET #1, 43: tra = CVS(n$): GET #1, 44: hvp = CVS(n$)
GET #1, 45: hmvp = CVS(n$)

LOCATE l1, c1
PRINT USING " Tra.  = ##.####^^^^"; tra
LOCATE l1 + 1, c1
PRINT USING "H(vp)  = ##.####^^^^"; hvp
LOCATE l1 + 2, c1
PRINT USING "Hm(vp) = ##.####^^^^"; hmvp

RETURN

sres:

GET #1, wlin + col + 10: ey = CVS(n$)
GET #1, wlin + col + 11: vy = CVS(n$)

LOCATE l1, c1
PRINT tipa$
LOCATE l1 + 1, c1
PRINT USING "<&> = ##.####^^^^"; uy$; ey
LOCATE l1 + 2, c1
PRINT USING "Õ(&)= ##.####^^^^"; uy$; vy

RETURN

' =========================================================================
'                       C A L C U L
' =========================================================================

calcul:

        CLS

        PRINT "OPCIONS DE CALCUL:": PRINT : PRINT

        IF lin > 1 AND col <= dima THEN PRINT "1) Mitja entre linees."
        PRINT "2) Calcul y(x) = y(x) * x"
        PRINT "3) Logaritme"
        PRINT "4) Estadística de de línea"
        PRINT "5) Boltzman"
        PRINT "6) Test regresió lineal de Boltzman (per espectres)"

        PRINT : PRINT
        INPUT "Entra opció:  "; calcul
        IF calcul = 1 THEN GOTO mitjalin
        IF calcul = 2 THEN GOTO potencia
        IF calcul = 4 THEN GOTO estadlin
        IF calcul = 5 THEN GOTO boltzman
        IF calcul = 6 THEN GOTO reglinboltz
        GOTO dibuix

boltzman:

    PRINT
    INPUT "entra mitja  ", mb
   

    max = 0: min = 0
    FOR x = 0 TO col ? 1
        xc = x + 1
        a(xc) = EXP(?x * ux / mb) / mb
        IF a(xc) > max THEN max = a(xc)
        IF a(xc) < min THEN min = a(xc)
    NEXT

    maxr = max: minr = min
    GOSUB escalay
    reg.ini.seg = 0
    GOTO dibuix

mitjalin:

        CLS
        INPUT "Entra linea inicial, linea final"; eli, elf
        IF eli = 0 THEN eli = 1
        IF elf = 0 THEN elf = lin

        nl = elf ? eli + 1

        FOR esx = 1 TO col: a(esx) = 0: NEXT

        FOR l = eli TO elf

        ri = wi + (l ? 1) * (col + colsup)
        nreg.seg = col
        op = 2: lreg = 4: n = 1
        CALL arxiuh(1, op, lreg, ea(), n, nreg.seg, ri): ' a(n)

                FOR esx = 1 TO nreg.seg
                        a(esx) = a(esx) + ea(esx)
                NEXT esx
        NEXT l

        min = 0: max = 0
        FOR esx = 1 TO nreg.seg
                a(esx) = a(esx) / nl
                IF a(esx) > max THEN max = a(esx)
                IF a(esx) < min THEN min = a(esx)
        NEXT

        maxr = max: minr = min
        GOSUB escalay
        reg.ini.seg = 0
        GOTO dibuix

potencia:

        max = 0: min = 0
        FOR x = 1 TO col
            a(x) = a(x) * (x ? 1 + coor.x.ini.linea) * ux
            IF a(x) > max THEN max = a(x)
            IF a(x) < min THEN min = a(x)
        NEXT

        maxr = max: minr = min
        GOSUB escalay
        reg.ini.seg = 0
        GOTO dibuix

estadlin:

sumy = 0
ey = 0: vy = 0
ex = 0: vx = 0
FOR x = 1 TO col
    sumy = sumy + a(x)
    vy = vy + a(x) ^ 2
    ex = ex + (xi + (x ? 1) * ux) * a(x)
    vx = vx + (xi + (x ? 1) * ux) ^ 2 * a(x)
NEXT
ex = ex / sumy
vx = vx / sumy ? ex ^ 2
ey = sumy / col
vy = vy / col ? ey ^ 2

' calculem l'entropia en nats   

h = 0
FOR x = 1 TO col
    an = a(x) / (sumy * ux)
    IF a(x) > 0 THEN h = h + an * LOG(an)
NEXT
h = ?h * ux
hmb = 1 + LOG(ex)
hme = LOG(col)

IF ux$ = "seg." AND ux > .1 THEN
    CALL temps(ex, hex, mex, sex)
    CALL temps(vx, hvx, mvx, svx)
END IF
       

PRINT : PRINT
PRINT USING "  õy  = ##.####^^^^ &"; sumy; uy$
PRINT
PRINT USING " <y>  = ##.####^^^^ &"; ey; uy$
PRINT USING "Õ(y)  = ##.####^^^^ &"; vy; uy$
PRINT
IF ux$ = "seg." AND ux > .1 THEN
    PRINT USING " <x>  = ##:##:## &"; hex; mex; sex; ux$
    PRINT USING "Õ(x)  = ##:##:## &"; hvx; mvx; svx; ux$
ELSE
    PRINT USING " <x>  = ##.####^^^^ &"; ex; ux$
    PRINT USING "Õ(x)  = ##.####^^^^ &"; vx; ux$
END IF
PRINT
PRINT USING " H(x)   = ###.#### nats"; h
PRINT USING "H(bolt) = ###.#### nats"; hmb
PRINT USING "H(equi) = ###.#### nats"; hme

WHILE INKEY$ = "": WEND
       

       
GOTO dibuix

reglinboltz:

' transformem l'espectre normalitzat en una funció lineal i despres
' calculem la recta de regresió (exepte del primer valor f=0)

CLS
PRINT "regressió lineal d'un espectre, via funció de Boltzman"
PRINT : PRINT
INPUT "Entra coli [2], colf [col]  actives pel càlcul  ", ci, cf

IF ci = 0 THEN ci = 2
IF cf = 0 THEN cf = col

n = cf ? ci + 1

' normalitzem la linea (espectre) i calculen el ln

suma = 0: ef = 0
FOR x = 1 TO col
    suma = suma + a(x)
    ef = ef + (xi + (x ? 1) * ux) * a(x)
NEXT
ef = ef / suma: ' frecuencia mitja espectral
b = ?1 / ef
ex = (xi + (ci + cf ? 2) * ux) / 2: ' mitja del rang de la variable f actiu

ep = 0: max = 0: min = 0
FOR x = 1 TO col
    a(x) = a(x) / (suma * ux)
    IF a(x) > 0 THEN a(x) = LOG(a(x))
    IF x >= ci AND x <= cf THEN ep = ep + a(x)
    IF a(x) > max THEN max = a(x)
    IF a(x) < min THEN min = a(x)
NEXT
ep = ep / n: ' mitja de la probabilitat del espectre lineal

' calculem els parametres de regressió a* i b*
ben = 0: bed = 0
FOR x = ci TO cf
    ben = ben + (xi + (x ? 1) * ux) * a(x) ? ex * ep
    bed = bed + (xi + (x ? 1) * ux) ^ 2 ? ex ^ 2
NEXT
be = ben / bed

ae = ep ? be * ex

' calculem l'estadistic t

syx = 0: sx = 0
FOR x = ci TO cf
    syx = syx + (a(x) ? (ae + be * (xi + (x ? 1) * ux))) ^ 2
    sx = sx + ((xi + (x ? 1) * ux) ? ex) ^ 2
NEXT
syx = SQR(syx / n)
sx = SQR(sx / n)

t = (be ? b) * SQR((n ? 2)) * sx / syx

' presentem resultats

PRINT : PRINT
PRINT USING "rang de frecuencies:  fi = ###.#### Hz (####)     ff = ###.#### Hz (####)"; (ci ? 1) * ux; ci; (cf ? 1) * ux; cf
PRINT
PRINT USING "valors empirics:    <f>  = ###.####       b  = ##.####"; ef; b
PRINT USING "valors estimats:    <f>* = ###.####       b* = ##.####        a* = ##.####"; ?1 / be; be; ae
PRINT
PRINT USING "norma (mitja cuadratica del error d'ajust):  ##.#####"; syx
PRINT
PRINT USING "estadistic t (b* ? b):  ##.####         g.l. (n?2): ####"; t; n ? 2

WHILE INKEY$ = "": WEND

maxr = max: minr = min
GOSUB escalay
reg.ini.seg = 0
GOTO dibuix

' =========================================================================
'                       C E N T R E
' =========================================================================

centre:
        cxm = 0: cym = ycero
        ix = multx * 8: iy = UniY * 8

dibcent:
        cyar = panymax
        cybr = cyb + 36 * (cya ? cyb) / 200

        IF cxm > INT((nreg.pan ? 1) * multx) THEN
            cxm = INT((nreg.pan ? 1) * multx)
        END IF
       

        IF cxm < 0 THEN cxm = 0
        IF cym > panymax THEN cym = cym ? iy
        IF cym < panymin THEN cym = cym + iy

        IF marca = 1 THEN
                GET (cxm, cyar)?(cxm, cybr), p(0)
                LINE (cxm, cyar)?(cxm, cybr)
                END IF
        IF marca = 2 THEN
                GET (0, cym)?(Punts.Pan.X.Pos, cym), p(1000)
                LINE (0, cym)?(Punts.Pan.X.Pos, cym)
                END IF

                IF marca = 1 THEN
                        LOCATE 24, 28
                        cxv = coor.x.ini.pan + cxm / multx * ux
                        PRINT "[X:";
                        IF ux$ = "seg." AND ux > .02 THEN
                                CALL temps(cxv, cxvh, cxvm, cxvs)
                                PRINT USING "#:##:##.###   Y:"; cxvh; cxvm; cxvs;
                                ELSE
                                PRINT USING "##.####^^^^   Y:"; cxv;
                                END IF
                        PRINT USING "##.##^^^^^]"; a(reg.ini.pan.act + cxm / multx + 1);
                        END IF

                IF marca = 2 THEN
                        LOCATE 24, 28
                        PRINT USING "[Y: ##.##^^^^^]"; cym;
                        END IF

        RETURN

borcent:
        IF marca = 1 THEN
                PUT (cxm, cybr), p(0), PSET
                END IF
        IF marca = 2 AND cym <= cya THEN
                PUT (0, cym), p(1000), PSET
                END IF
        RETURN

posapila:

        CLOSE #3: OPEN "grafic.pil" FOR RANDOM AS #3 LEN = LEN(pila(0))
        GET #3, 1, pila(1)
        IF pila(1).liact < 1 THEN pila(1).liact = 1
        IF fich = 0 THEN
                pila(1).liact = pila(1).liact + 1
                fich = pila(1).liact
        END IF
        pila(fich).arx = arx$: pila(fich).liact = li.act
        pila(fich).inc = inc: pila(fich).segact = seg.act
        pila(fich).reginipan = reg.ini.pan.act
        pila(fich).marca = marca
        pila(fich).cxm = cxm: pila(fich).ix = ix
        pila(fich).cym = cym: pila(fich).iy = iy
        pila(fich).est = est: pila(fich).rec = rec
        pila(fich).multx = multx: pila(fich).escy = escy
        pila(fich).xii = coor.x.ini.linea
        pila(fich).maxr = maxr
        pila(fich).minr = minr
        PUT #3, fich, pila(fich)
        pila(1).inc = fich: PUT #3, 1, pila(1)
        CLOSE #3

RETURN

' ===========================================================================
'   calculem l'escala del eix x i el format decimal dels valors d'escala
' ===========================================================================

escalax:
       

marcr = INT((Punts.Pan.X.Pos + 1) / multx) / 5 * ux

e = 0: marc = marcr: fdec$ = ""

IF marc >= 10 THEN
        WHILE marc >= 10
            marc = marc / 10: e = e + 1
        WEND
ELSE
    IF marc < 1 THEN
        fdec$ = "."
        WHILE marc < 1
            marc = marc * 10: e = e ? 1
            fdec$ = fdec$ + "#"
        WEND
        IF fdec$ = "." THEN fdec$ = ""
    END IF
END IF

marc = INT(marc)
uni.marca = 10 ^ e
punts.marca = INT(marcr / ux) * multx

RETURN

' ===========================================================================
'       calculem l'escala del eix y (cyai,cybi,cya,cyb)
' ===========================================================================

escalay:

IF escy = 1 THEN RETURN

RangY = maxr ? minr
UniY = RangY / (130 ? 6)

cyai = maxr + 27 * UniY
cybi = minr ? (43 + 6) * UniY

cya = cyai: cyb = cybi

ycero = 0
IF max < 0 THEN ycero = maxr: ' + 6 * UniY
IF min > 0 THEN ycero = minr: ' ? 6 * UniY

panymin = cyb + 43 * UniY
panymax = cyb + 190 * UniY

RETURN

' ===========================================================================
'              determinem tipa$ i uy$ si cal
' ===========================================================================

tipusarxiu:

        tipr$ = tip$

tipusa:

IF tipr$ = "STII" THEN tipa$ = "MOSTREIG INTEGRAT (STII)": RETURN
IF tipr$ = "STI " THEN tipa$ = "MOSTREIG INTEGRAT (STI)": RETURN
IF tipr$ = "STI2" THEN tipa$ = "MOSTREIG INTEGRAT (STI2)": RETURN
IF tipr$ = "STA2" THEN tipa$ = "MOSTREIG INTEGRAT (STA2)": RETURN
IF tipr$ = "STD " THEN tipa$ = "MOSTREIG DIRECTE": RETURN
IF tipr$ = "ESP " THEN tipa$ = "ESPECTRE": RETURN
IF tipr$ = "DENY" THEN tipa$ = "DENSITAT Y": RETURN
IF tipr$ = "EDPD" THEN tipa$ = "ESPECTRE DIF. PICS DIR.": RETURN
IF tipr$ = "EDPI" THEN tipa$ = "ESPECTRE DIF. PICS INV.": RETURN
IF tipr$ = "DPIC" THEN tipa$ = "DENSITAT DE PICS": RETURN
IF tipr$ = "PACP" THEN tipa$ = "Y:VECT. PROPI  X:ESPECTRES": RETURN
IF tipr$ = "DCB " THEN tipa$ = "DECIBELS": RETURN
IF tipr$ = "DIAG" THEN tipa$ = "VALORS PROPIS": RETURN
IF tipr$ = "COV " THEN tipa$ = "COVARIANÇA": RETURN
IF tipr$ = "DIST" THEN tipa$ = "DISTANCIA": RETURN
IF tipr$ = "ENST" OR tipr$ = "ENDB" OR tipr$ = "ENDS" THEN tipa$ = "ENTROPIA": RETURN

IF tipr$ = "PARL" OR tipr$ = "SRES" THEN
        GET #1, wlin + col + 2: tipr$ = n$
        GOTO tipusa
END IF

IF tipr$ = "SESP" THEN
        tipa$ = "SERIE D'ESPECTRES"
        IF li.act > lin THEN
                IF li.act = lin + 1 THEN tipa$ = "MITJA D'ESPECTRES"
                IF li.act = lin + 2 THEN tipa$ = "DESV.TIP. D'ESPECTRES"
        END IF
        RETURN
END IF

IF tipr$ = "<ES>" THEN
        IF tip$ = "SRES" THEN tipa$ = "SERIE D'ESPECTRES": RETURN
        IF li.act = 1 THEN tipa$ = "MITJA D'ESPECTRES"
        IF li.act = 2 THEN tipa$ = "DESV.TIP. D'ESPECTRES"
        RETURN
END IF

IF tipr$ = "SIL " THEN
        IF tip$ = "SRES" THEN tipa$ = "SILENCI": RETURN
        IF li.act = 1 THEN tipa$ = "DENS. DE SILENCIS"
        IF li.act = 2 THEN tipa$ = "DENS. DE NO SILENCIS"
        RETURN
END IF

RETURN

' ===========================================================================
'              dibuixem linees i marques dels eixos x e y
' ===========================================================================

dibuixaeixos:

' coord. de punts pantalla per linees i marques
WINDOW (Punts.Pan.X.Pos, maxpuntsypos)?(punts.pan.x.neg, maxpuntsyneg)

' marquem linea del eix x i del eix y
IF rec = 0 THEN
    punts.linea.eix.x.pos = nreg.pan * multx + 100
    IF punts.linea.eix.x.pos > Punts.Pan.X.Pos THEN
        punts.linea.eix.x.pos = Punts.Pan.X.Pos
    END IF
    LINE (punts.linea.eix.x.pos, 0)?(punts.pan.x.neg, 0)
    LINE (?10, 0)?(?10, 133): ' eix y
END IF

' si estem recubrin deixar les marques de la primera panina
IF rec = 1 THEN RETURN

' dibuixem les marques del eix x

coor.x.ini.pan = (reg.ini.seg + reg.ini.pan.act) * ux + coor.x.ini.linea
coor.marca.x.ini = INT(coor.x.ini.pan / uni.marca) * uni.marca
WHILE coor.marca.x.ini < coor.x.ini.pan
    coor.marca.x.ini = coor.marca.x.ini + uni.marca
WEND

' determinem el format dels números de les marques del eix x
' en funció del valor de la coordenada de la marca final del eix x
IF ux$ = "seg." AND ux > .02 THEN
    frnum$ = "##:##:##"
ELSE
    ' nomes la part entera de número
    ' la part decimal ja es calcula en el eix x
    vf = coor.marca.x.ini + nreg.pan * ux: ' rang en unitats arxiu
    fent$ = "#"
    WHILE vf > 10
        fent$ = fent$ + "#": vf = vf / 10
    WEND
    frnum$ = fent$ + fdec$
END IF
lfrnum = LEN(frnum$)
centf = lfrnum * 4

x1 = ((coor.marca.x.ini ? coor.x.ini.linea) / ux ? (reg.ini.seg + reg.ini.pan.act)) * multx

mp4 = (marc * uni.marca) / 4 / ux * multx

IF x1 ? mp4 >= 0 THEN
        FOR mp = x1 ? mp4 TO 0 STEP ?mp4
                LINE (mp, ?3)?(mp, 0)
        NEXT
END IF

marc1:
       

LINE (x1, ?5)?(x1, 0)

c1 = INT(((x1 + 39) ? centf) / 8) + 1

IF c1 + lfrnum < 75 THEN
        LOCATE 22, c1
        IF ux$ = "seg." AND ux > .02 THEN
                CALL temps(coor.marca.x.ini, v1h, v1m, v1s)
                PRINT USING frnum$; v1h; v1m; v1s;

                ELSE
                PRINT USING frnum$; coor.marca.x.ini;
        END IF
END IF

FOR mp = 1 TO 3
        cxls = x1 + mp4 * mp
        IF cxls <= punts.linea.eix.x.pos THEN LINE (cxls, ?3)?(cxls, 0)
NEXT

IF x1 <= punts.linea.eix.x.pos ? punts.marca THEN
        coor.marca.x.ini = coor.marca.x.ini + marc * uni.marca
        x1 = ((coor.marca.x.ini ? coor.x.ini.linea) / ux ? (reg.ini.seg + reg.ini.pan.act)) * multx
        GOTO marc1
END IF

i1 = nreg.pan / 8 * multx + 18: IF i1 > 76 THEN i1 = 76
LOCATE 22, i1: PRINT ux$;
LOCATE 1, 1: PRINT uy$;

RETURN

xecpan:

IF reg.ini.pan.act < 0 THEN reg.ini.pan.act = 0
IF reg.ini.pan.act > nreg.seg ? nreg.pan THEN
    reg.ini.pan.act = nreg.seg ? nreg.pan
END IF
IF reg.ini.pan.act = reg.ini.pan.ant THEN GOTO ordre
GOTO dibuix

REM $STATIC
'
' PROCEDIMENT  ARXIUH:  per matrius enteres
'
' Graba o llegeix d'un arxiu per blocs.
'
SUB arxiuh (numarx, op, lreg, mat(), n, nreg, ri)

DIM regen(9) AS INTEGER, regso(9) AS INTEGER
CONST ax = 0, bx = 1, cx = 2, dx = 3
CONST bp = 4, si = 5, di = 6, fl = 7
CONST ds = 8, es = 9

' obtenim el handle del arxiu

hand = FILEATTR(numarx, 2)

' situem el punter del arxiu al registre inicial (ri)
' interrupció 42h

regen(bx) = hand

regi& = (ri ? 1) * lreg

rcx& = regi& \ 65536
IF rcx& > 32767 THEN rcx& = rcx& ? 65536
regen(cx) = rcx&

rdx& = regi& MOD 65536
IF rdx& > 32767 THEN rdx& = rdx& ? 65536
regen(dx) = rdx&

' al = 0 , mou el punter des del principi del arxiu

regen(ax) = &H42 * 256
CALL INT86XOLD(&H21, regen(), regso())

' comprobem si hi ha error ( CF = 1)
IF (regso(fl) AND 1) > 0 THEN
        PRINT USING "Error ## en moure punter al arxiu ##"; regso(ax); hand
        STOP
END IF

' Llegim o grabem (3Fh o 40h)

regen(bx) = hand

nbytes& = nreg * lreg
IF nbytes& > 32767 THEN nbytes& = nbytes& ? 65536
regen(cx) = nbytes&

' situem el buffer de dades a mat(n)
' ds:dx apunta a mat(n) = buffer de dades

smat% = VARSEG(mat(0))
regen(ds) = smat%

dmat& = n * 4
IF dmat& > 32767 THEN dmat& = dmat& ? 65536
regen(dx) = dmat&

SELECT CASE op
        CASE 1
                ' grabar
                regen(ax) = &H40 * 256
                CALL INT86XOLD(&H21, regen(), regso())

                ' comprobem si hi ha error ( CF = 1)
                IF (regso(fl) AND 1) > 0 THEN
                        PRINT USING "Error ## en grabar l'arxiu ##"; regso(ax); hand
                        STOP
                END IF
        CASE 2
                ' llegir
                regen(ax) = &H3F * 256
                CALL INT86XOLD(&H21, regen(), regso())
             

                ' comprobem si hi ha error ( CF = 1)
                IF (regso(fl) AND 1) > 0 THEN
                        PRINT USING "Error ## en llegir l'arxiu ##"; regso(ax); hand
                        STOP
                END IF
END SELECT

END SUB

SUB fixer

LOCATE 1, 50: INPUT "Arxiu sortida : ", arxs$
IF arxs$ = "" THEN EXIT SUB

LOCATE 1, 50: PRINT SPACE$(31);
LOCATE 1, 50: INPUT "([0]:igual/1:trasposta) ", tip

OPEN arxs$ FOR OUTPUT AS #5

IF tip = 0 THEN
    WRITE #5, 1, ux, xi
    WRITE #5, nreg.seg, uy, yi
ELSE
    WRITE #5, nreg.seg, ux, xi
    WRITE #5, 1, uy, yi
END IF

PRINT

FOR x = 1 TO nreg.seg
    PRINT #5, a(x);
    IF tip = 1 THEN PRINT #5, ""
NEXT

CLOSE 5

END SUB

SUB temps (t, th, tm, ts)

th = t \ 3600: tm = (t ? th * 3600) \ 60
ts = t ? th * 3600 ? tm * 60

END SUB