Nombre d'objets

' Anasource.bas: liste des variables, objets, étiquettes du dernier source enregistré
DIM f$, fm$, a$, b$, c$, a1$, i%, k%, k1%, k2%, nl%, nvar%, neti%, nobj%, ign%, n%
DIM u%, tob%, v$, lv%, sva$, dir$
DIM objn$(30), var$(200), eti$(100), obj$(100)
LABEL ra, rb, rc, rd, re, rf, rg, rh, Suit1, Suit2, Suit3, Suit4, Suit5
LABEL Tri, Misfo, Recvar, rcvs, Receti, rces, Instrs, Mids, Trace
error_french: on_error_goto Trace
DATA "FORM ","BUTTON ","CHECK ","CONTAINER ","DLIST ","LIST ","EDIT ","MEMO "
DATA "OPEN_DIALOG ","TIMER ","PICTURE ","ALPHA ","COMBO ","MOVIE ","GRID "
DATA "OPTION ","SCENE2D ","SCENE3D","SCROLL_BAR ","SOUND ","SPIN ","SPRITE "
DATA "#"
tob% = 0: READ a$
WHILE a$ <> "#": tob% = tob% + 1: objn$(tob%) = a$: READ a$ : END_WHILE

' analyse du dernier source qui a été enregistré:
dir$ = "C:\LANGAGES\Panoramic": ' répertoire des sources
fm$ = "C:\TEMP\tt.tmp": ' fichier de manoeuvre

EXECUTE_WAIT "Cmd.exe /C DIR " + dir$ + "\*.bas /O:-D /B >" + fm$
FILE_OPEN_READ 1, fm$
FILE_READLN 1, f$: FILE_CLOSE 1: FILE_DELETE fm$
' f$ = "C:\LANGAGES\Panoramic\Etiquette.bas": ' ***** SOURCE A ANALYSER *****

PRINT "- Programme source: " + f$
nvar% = 0: neti% = 0: nobj% = 0
' ***** VARIABLES DÉCLARÉES (DIM) *****************************************
PRINT "Recherche des variables déclarées..."
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit1
    k% = INSTR(UPPER$(a$), "DIM ")
    IF k% > 0
        a$ = MID$(a$, k%+4, LEN(a$)-k%-3)
ra:
        k% = INSTR(a$, ":"): a1$ = ""
        IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1)
        k% = INSTR(a$, "(")
        IF k% > 0
            b$ = MID$(a$, k%+1, LEN(a$)-k%)
            k2% = INSTR(b$, ")")
            IF k2% > 0
                k1% = INSTR(b$, ",")
                IF k1% > 0 AND k1% < k2%
                    k1% = k% + k1%: k2% = k% + k2%
                    a$ = LEFT$(a$, k%-1)+"["+MID$(a$, k%+1, LEN(a$)-k%)
                    a$ = LEFT$(a$, k1%-1)+"."+MID$(a$, k1%+1, LEN(a$)-k1%)
                    IF k2% < LEN(a$)
                        a$ = LEFT$(a$, k2%-1)+"]"+MID$(a$, k2%+1, LEN(a$)-k2%)
                    ELSE
                        a$ = LEFT$(a$, k2%-1) + "]"
                    END_IF
                END_IF
            END_IF
        END_IF
rb:
        k% = INSTR(a$, ",")
        nvar% = nvar% + 1: b$ = STR$(nl%): b$ = STRING$(5-LEN(b$)," ") + b$
        IF k% > 0
            var$(nvar%) = TRIM$(LEFT$(a$, k%-1)) + b$
            a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rb
        END_IF
        var$(nvar%) = TRIM$(a$) + b$
        IF a1$ <> "" THEN a$ = a1$: GOTO ra
    END_IF
Suit1:
END_WHILE
FILE_CLOSE 1
' *****  ÉTIQUETTES DÉCLARÉES (LABEL) ***********************************
PRINT "Recherche des labels déclarées..."
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit2
    k% = INSTR(UPPER$(a$), "LABEL ")
    IF k% > 0
        a$ = MID$(a$, k%+6, LEN(a$)-k%-5)
rc:
        k% = INSTR(a$, ":"): a1$ = ""
        IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1)
rd:
        k% = INSTR(a$, ",")
        neti% = neti% + 1: b$ = STR$(nl%): b$ = STRING$(5-LEN(b$)," ") + b$
        IF k% > 0
            eti$(neti%) = TRIM$(LEFT$(a$, k%-1)) + b$
            a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rd
        END_IF
        eti$(neti%) = TRIM$(a$) + b$
        IF a1$ <> "" THEN a$ = a1$: GOTO rc
    END_IF
Suit2:
END_WHILE
FILE_CLOSE 1
' ***** OBJETS DÉCLARÉS *******************************************
PRINT "Recherche des objets déclarés..."
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit3
    IF INSTR(UPPER$(a$), "DATA ") > 0 THEN GOTO Suit3
    IF INSTR(UPPER$(a$), "DIM ") > 0 THEN GOTO Suit3
    IF INSTR(UPPER$(a$), "LABEL ") > 0 THEN GOTO Suit3
    FOR i% = 1 TO tob%
        v$ = objn$(i%): lv% = LEN(v$)
        u% = 1
re:
        b$ = v$: GOSUB Instrs: k% = k1%
        IF k% > 0
            IF k% > 1
                n% = ASC(MID$(a$, k%-1, 1))
                if n%>32 then goto rg
            END_IF
            u% = k%: b$ = ":": GOSUB Instrs
            IF k1% > 0
                c$ = MID$(a$, k%+lv%, k1%-k%-lv%)
            ELSE
                k% = k% + lv%: GOSUB Mids: c$ = b$
            END_IF
            c$ = TRIM$(c$)
            nobj% = nobj% + 1: obj$(nobj%) = v$ + c$ + " ["+STR$(nl%)+"]"
rg:
            IF k1% > 0 THEN u% = k1%+1: GOTO re
        END_IF
    NEXT i%
Suit3:
END_WHILE
FILE_CLOSE 1
' remise en forme des déclarations de tableaux à double entrée
' (remplacement des crochets par des parenthèses)
FOR i% = 1 TO nvar%
    a$ = var$(i%)
    k% = INSTR(a$, "[")
    IF k% > 0
        a$ = LEFT$(a$, k%-1) + "(" + MID$(a$, k%+1, LEN(a$)-k%)
        k% = INSTR(a$, "]")
        IF k% > 0
            a$ = LEFT$(a$, k%-1) + ")" + MID$(a$, k%+1, LEN(a$)-k%)
            k% = INSTR(a$, ".")
            IF k% > 0 THEN a$ = LEFT$(a$, k%-1) + "," + MID$(a$, k%+1, LEN(a$)-k%)
        END_IF
        b$ = LEFT$(a$, LEN(a$)-5)
        FOR k% = 1 TO LEN(b$): ' suppression éventuelle des espaces superflus
            IF MID$(a$, k%, 1)=" " THEN b$=LEFT$(b$, k%-1) + MID$(b$,k%+1,LEN(b$)-k%)
        NEXT k%
        var$(i%) = b$ + RIGHT$(a$, 5)
    END_IF
NEXT i%
PRINT "Tri alphabétique des résultats..."
GOSUB Tri

' ajout des crochets autour des numéros de lignes
FOR i% = 1 TO nvar%
    var$(i%) = LEFT$(var$(i%), LEN(var$(i%))-5) + " [" + TRIM$(RIGHT$(var$(i%),5)) + "]"
NEXT i%
FOR i% = 1 TO neti%
    eti$(i%) = LEFT$(eti$(i%), LEN(eti$(i%))-5) + " [" + TRIM$(RIGHT$(eti$(i%),5)) + "]"
NEXT i%

' *****  RECHERCHE DES VARIABLES DANS LE CODE *******************************
PRINT "Recherche des variables dans le code..."
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit4
    k% = INSTR(UPPER$(a$), "DIM ")
    IF k% > 0
        ' c'est une ligne de DIM
        a1$ = "": IF k% > 1 THEN a1$ = LEFT$(a$, k%-1)
        b$ = MID$(a$, k%, LEN(a$)-k%+1)
        k1% = INSTR(b$, ":")
        IF k1% > 0
            a$ = a1$ + MID$(b$, k1%, LEN(b$)-k1%+1)
        ELSE
            a$ = a1$
        END_IF
        IF TRIM$(a$) = "" THEN GOTO Suit4
    END_IF
    FOR n% = 1 TO nvar%
        v$ = var$(n%): k% = INSTR(v$, " "): v$ = LEFT$(v$, k%-1)
        GOSUB Recvar
        IF ign% = 0 THEN var$(n%) = var$(n%) + "," + STR$(nl%)
    NEXT n%
Suit4:
END_WHILE
FILE_CLOSE 1

' ***** RECHERCHE DES APPELS AUX LABELS DANS LE CODE ************************
PRINT "Recherche des labels dans le code..."
FILE_OPEN_READ 1, f$: nl% = 0
WHILE FILE_EOF(1) = 0
    nl% = nl% + 1: FILE_READLN 1, a$: GOSUB Misfo: IF ign% = 1 THEN GOTO Suit5
    k% = INSTR(UPPER$(a$), "LABEL "): IF k% > 0 THEN GOTO Suit5
    FOR i% = 1 TO neti%
        v$ = eti$(i%): k% = INSTR(v$, " "): v$ = LEFT$(v$, k%-1)
        GOSUB Receti
        IF ign% = 0 THEN eti$(i%) = eti$(i%) + "," + STR$(nl%)
    NEXT i%
Suit5:
END_WHILE
FILE_CLOSE 1
   
' ***************************************************************************

' ***** AFFICHAGE SOMMAIRE DES RÉSULTATS ************************************
HEIGHT 0, SCREEN_Y-30: WIDTH 0, 900: CLS
LIST 1: HEIGHT 1, SCREEN_Y-80: WIDTH 1, 880
FONT_NAME 1, "Lucida Console": FONT_SIZE 1,9
ITEM_ADD 1, "- " +f$ + " -"
a$ = " Total = " + STR$(nvar%) + " variables, " + STR$(neti%) + " étiquettes, "
a$ = a$ + STR$(nobj%) + " objets."
ITEM_ADD 1, a$
FOR i% = 1 TO nvar%
    ITEM_ADD 1, var$(i%)
NEXT i%
ITEM_ADD 1, " - ÉTIQUETTES -"
FOR i% = 1 TO neti%
    ITEM_ADD 1, eti$(i%)
NEXT i%
ITEM_ADD 1, " - OBJETS -"
FOR i% = 1 TO nobj%
    ITEM_ADD 1, obj$(i%)
NEXT i%
END
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Tri:
DLIST 99
FOR i% = 1 TO nvar%: ITEM_ADD 99, var$(i%): NEXT i%
SORT 99
FOR i% = 1 TO nvar%: var$(i%) = ITEM_READ$(99, i%): NEXT i%
CLEAR 99
FOR i% = 1 TO neti%: ITEM_ADD 99, eti$(i%): NEXT i%
SORT 99
FOR i% = 1 TO neti%: eti$(i%) = ITEM_READ$(99, i%): NEXT i%
DELETE 99
RETURN

Misfo:
' Mise en forme de a$ avant analyse (élimination des éléments superflus)
ign% = 0
a$ = TRIM$(a$): IF a$ = "" THEN ign% = 1: RETURN
k% = INSTR(a$, CHR$(34)+CHR$(39)+CHR$(32)+CHR$(34)): IF k% = 1 THEN ign% = 1: RETURN
k% = INSTR(a$, CHR$(39)+CHR$(32))
IF k% > 0 THEN a$ = RTRIM$(LEFT$(a$, k%-1))
IF RIGHT$(a$, 1) = ":" THEN a$ = LEFT$(a$, LEN(a$) - 1)
' Éliminer le contenu entre quotes (merci Nardo)
u% = 1
rh:
b$ = CHR$(34): GOSUB Instrs: k% = k1%
IF k% > 0
    b$ = MID$(a$, k%+1, LEN(a$)-k%)
    k1% = INSTR(b$, CHR$(34))
    IF k1% > 0
        a$ = LEFT$(a$, k%) + MID$(b$, k1%, LEN(b$)-k1%+1)
        u% = k%+2: GOTO rh
    END_IF
END_IF
RETURN

Recvar:
' Recherche de la variable v$ dans a$
sva$ = a$: ign% = 0
k% = INSTR(v$, "("): ' tableaux
IF k% > 0 THEN v$ = LEFT$(v$, k%)
lv% = LEN(v$)
rf:
k% = INSTR(a$, v$): IF k% < 1 THEN ign% = 1: GOTO rcvs
IF k% > 1
    c$ = MID$(a$, k%-1, 1): ' c'est pas le 1er, caractère précédent
    IF c$<>" " AND c$<>"+" AND c$<>"-" AND c$<>"*" AND c$<>"/"
        IF k% = LEN(a$) THEN ign% = 1: GOTO rcvs
        a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rf
    END_IF
END_IF
IF k% <= (LEN(a$)-lv%) AND RIGHT$(v$, 1) <> "("
    c$ = MID$(a$, k%+lv%, 1): ' c'est pas le dernier ni tableau, caractère suivant
    IF c$<>" "AND c$<>"+"AND c$<>"-" AND c$<>"*" AND c$<>"/"AND c$<>":"
        a$ = MID$(a$, k%+1, LEN(a$)-k%): GOTO rf
    END_IF
END_IF
rcvs:
a$ = sva$
RETURN

Receti:
' Recherche de l'étiquette v$ dans a$
sva$ = a$: ign% = 0: lv% = LEN(v$)
k% = INSTR(a$, v$)
IF k% = 1 AND a$ = v$ THEN GOTO rces: ' étiquette en place
IF k% < 6 THEN ign% = 1: GOTO rces
IF MID$(a$, k%-1, 1) <> " " THEN ign% = 1: GOTO rces
IF LEN(a$) < (k% + lv%) THEN GOTO rces
c$ = MID$(a$, k%+lv%, 1)
IF c$ <> ":" AND c$ <> " " THEN ign% = 1: GOTO rces
rces:
a$ = sva$
RETURN

Instrs:
' recherche de b$ dans a$ à partir de u% -> k1%
IF u% <= LEN(a$)
    c$ = MID$(a$, u%, LEN(a$)-u%+1)
    k1% = INSTR(c$, b$)
    IF k1% > 0 THEN k1% = k1% + u% - 1
ELSE
    k1% = 0
END_IF
RETURN

Mids:
' renvoie la chaîne b$, reste de a$ à partir de k% (y compris vide)
IF k% <= LEN(a$)
    b$ = MID$(a$, k%, LEN(a$)-k%+1)
ELSE
    b$ = ""
END_IF
RETURN

Trace:
Message "Erreur ligne " + str$(error_line)+": "+error_type$
TERMINATE