Analyse d'un programme source .bas

' Analyse d'un programme source Panoramic (.bas)
DIM w0, h0, a$, a1$, b$, c$, v$, sva$, fm$, fn$, f$, fs$, font$, fsz%, fpr%, afl%
DIM i%, j%, k%, k1%, k2%, n%, nl%, u%, ign%, lv%, flf%, fls%, dir$, flsz%, lc%, nc%
DIM objn$(50), var$(100), obj$(100), eti$(80), tob%, nvar%, nobj%, neti%, wf, hf
DIM indt%, car$(20), tca%, p$, s$, marg%, ll%(5000)

LABEL opn, opn1, sav, savs, sauve, impr, quit, chp, cnl, vfont, vlf, new, copy
LABEL paste, cut, Misfo, Listvar, Recvar, Reclab, Receti, Recobj, Recif, Recsou
LABEL Instrs, Mids, der, ra, rb, rc, rd, re, rf, rg, rk, rces, rcvs
LABEL Suit1, Suit2, Suit3, Suit4, Suit41, Suit5, Suit51, Suit6, Suit7, Suit8, Suit9
LABEL Recwhile, Recrep, Recseq, Debug, Ecsva, Supelem, Charsou, Afl, Supquot
' ERROR_FRENCH: ON_ERROR_GOTO Debug
' Noms des objets Panoramic:
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 "MAIN_MENU ","SUB_MENU "
DATA "#"
tob% = 0: READ a$
WHILE a$ <> "#": tob% = tob% + 1: objn$(tob%) = a$: READ a$ : END_WHILE
' Caractères susceptibles de côtoyer les variables dans le code
' (254 si variable en début de ligne, 255 si variable en fin de ligne)
DATA " ","=",":","+","-","*","/",",",">","<","(",")",";",CHR$(254),CHR$(255)
DATA "#"
tca% = 0: READ a$
WHILE a$ <> "#": tca% = tca% + 1: car$(tca%) = a$: READ a$: END_WHILE

fm$ = "C:\TEMP\fpri.tmp"
fn$ = "C:\TEMP\ftmp.tmp"
dir$ = "C:\LANGAGES\Panoramic": ' répertoire des sources Panoramic

w0 = 800: h0 = 900: h0 = SCREEN_Y-30
WIDTH 0, w0: HEIGHT 0, h0
CAPTION 0, " - ANALYSE D'UN PROGRAMME SOURCE PANORAMIC (.bas) -
afl% = 1: ' affichage implicite des numéros de lignes
marg% = 8

' Menus ---------------------------------------------------------------
MAIN_MENU 1

' Menu principal
SUB_MENU 2: CAPTION 2,"Fichier" : PARENT 2, 1
SUB_MENU 3: CAPTION 3,"Edition" : PARENT 3, 1
SUB_MENU 4: CAPTION 4,"Affichage": PARENT 4, 1
SUB_MENU 5: CAPTION 5,"Recherches": PARENT 5, 1

' Sous-menus 2 (Fichier)
SUB_MENU 21: CAPTION 21,"Nouveau" : PARENT 21, 2
SUB_MENU 22: CAPTION 22,"Ouvrir" : PARENT 22, 2
SUB_MENU 23: CAPTION 23,"Ouvrir dernier enregistré": PARENT 23, 2
SUB_MENU 24: CAPTION 24,"Enregistrer" : PARENT 24, 2
SUB_MENU 25: CAPTION 25,"Enregistrer sous...": PARENT 25, 2
SUB_MENU 26: CAPTION 26,"Imprimer": PARENT 26, 2
SUB_MENU 27: CAPTION 27,"Quitter" : PARENT 27, 2
ON_CLICK 21, new: ON_CLICK 22, opn: ON_CLICK 23, der: ON_CLICK 24, sav
ON_CLICK 25, savs: ON_CLICK 26, impr: ON_CLICK 27, quit

' Sous-menus 3 (Edition)
SUB_MENU 31: CAPTION 31,"Copier" : PARENT 31, 3
SUB_MENU 32: CAPTION 32,"Coller" : PARENT 32, 3
SUB_MENU 33: CAPTION 33,"Couper" : PARENT 33, 3
ON_CLICK 31, copy: ON_CLICK 32, paste: ON_CLICK 33, cut

' Sous-menus 4 (Affichage)
SUB_MENU 41: CAPTION 41,"Police": PARENT 41, 4
SUB_MENU 42: PARENT 42, 4
IF afl% = 0
    CAPTION 42,"Numéros de lignes"
ELSE
    CAPTION 42, "Suppr. N°s de lignes"
END_IF
ON_CLICK 41, chp: ON_CLICK 42, cnl

' Sous-menus 5 (Recherches)
SUB_MENU 51: CAPTION 51,"Variables": PARENT 51, 5
SUB_MENU 52: CAPTION 52,"Labels": PARENT 52, 5
SUB_MENU 53: CAPTION 53,"Objets": PARENT 53, 5
SUB_MENU 54: CAPTION 54,"If...Then...End_If": PARENT 54, 5
SUB_MENU 55: CAPTION 55,"While...End_While": PARENT 55, 5
SUB_MENU 56: CAPTION 56,"Repeat...Until": PARENT 56, 5
SUB_MENU 57: CAPTION 57,"Sous-programmes": PARENT 57, 5
SUB_MENU 58: CAPTION 58,"Séquence...": PARENT 58, 5
ON_CLICK 51, Listvar: ON_CLICK 52, Reclab: ON_CLICK 53, Recobj
ON_CLICK 54, Recif: ON_CLICK 55, Recwhile: ON_CLICK 56, Recrep
ON_CLICK 57, Recsou: ON_CLICK 58, Recseq
' Fin menus -------------------------------------------------------------

FORM 96: TOP 96, 60: LEFT 96, 50: HEIGHT 96, 180: WIDTH 96, 260: HIDE 96
CAPTION 96, "Police/Taille"
LIST 97: PARENT 97, 96: TOP 97, 5: HEIGHT 97, 90: WIDTH 97, 150
FONT_NAMES_LOAD 97: ON_CLICK 97, vfont
SPIN 98: PARENT 98, 96: TOP 98, 5: LEFT 98, 160: WIDTH 98, 60
POSITION 98, 10: MIN 98, 6: MAX 98, 30: ON_CLICK 98, vfont
BUTTON 99: PARENT 99, 96: TOP 99, 60: LEFT 99, 160: WIDTH 99, 80
CAPTION 99, "OK": ON_CLICK 99, vlf
LIST 100: PARENT 100, 96: TOP 100, 100: WIDTH 100, 240: HEIGHT 100, 40
font$ = "Bitstream Vera Sans Mono": fsz% = 10
FONT_NAME 100, font$: FONT_SIZE 100, fsz%
ITEM_ADD 100, font$
ITEM_ADD 100, "Voyez le Brick Géant Que J'examine Près du Wharf"

OPEN_DIALOG 11
FILTER 11,"Sources .bas|*.bas|Textes .txt|*.txt|Tous|*.*"
SAVE_DIALOG 13
FILTER 13,"Sources|*.bas|Textes|*.txt|Tous|*.*"

' Fenêtre principale d'affichage
fpr% = 12
MEMO fpr%: WIDTH fpr%, w0-16: HEIGHT fpr%, h0-56
FONT_NAME fpr%, font$: FONT_SIZE fpr%, fsz%
BAR_BOTH fpr%

' Fenêtre des résultats de recherches
flf% = 78: wf = 500: hf = h0-100
FORM flf%: TOP flf%, 60: LEFT flf%, 200: WIDTH flf%, wf: HEIGHT flf%, hf
HIDE flf%
fls% = flf%+1
LIST fls%: PARENT fls%, flf%
TOP fls%, 0: LEFT fls%, 0: WIDTH fls%, wf-16: HEIGHT fls%, hf-40
COLOR fls%, 255,255,220
flsz% = 10: ' taille caractères
FONT_NAME fls%, "Lucida Console": FONT_SIZE fls%, flsz%: FONT_COLOR fls%,0,0,128
lc% = INT(flsz%/1.25): IF FRAC(flsz%/1.25) >= 5 THEN lc% = lc%+1
nc% = INT(wf-20)/lc% - 4: ' nb de caractères affichables par ligne
END
' --------------------------------------------------------------------
quit:
TERMINATE
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
copy:
CLIPBOARD_COPY fpr%
RETURN
paste:
CLIPBOARD_PASTE fpr%
RETURN
cut:
CLIPBOARD_CUT fpr%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
new:
CLEAR fpr%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
opn:
f$ = FILE_NAME$(11): IF f$ = "_" OR f$ = "" THEN RETURN
opn1:
IF afl% = 0
    FILE_LOAD fpr%, f$
ELSE
    FILE_OPEN_READ 1, f$: FILE_OPEN_WRITE 2, fn$: nl% = 0
    WHILE FILE_EOF(1) = 0
        FILE_READLN 1, a$: nl% = nl% + 1
        a$ = STR$(nl%) + ": " + a$
        IF nl% < 1000 THEN a$ = STRING$(4-LEN(STR$(nl%)), " ") + a$
        FILE_WRITELN 2, a$
    END_WHILE
    FILE_CLOSE 1: FILE_CLOSE 2
    FILE_LOAD fpr%, fn$: FILE_DELETE fn$
END_IF
select_text fpr%, 4500, 50
CAPTION 0, f$ + " " + STR$(COUNT(fpr%)) + " lignes."
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
der:
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$ = dir$ + "" + f$: GOTO opn1
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
sav:
fs$ = f$: GOSUB sauve
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
savs:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
fs$ = FILE_NAME$(13): IF fs$ = "_" OR fs$ = "" THEN RETURN
GOSUB sauve
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
sauve:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
FILE_OPEN_WRITE 1, fs$
FOR i% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, i%)
    IF afl% = 1
        ' sauvegarde sans les numéros de lignes
        k% = INSTR(a$, ":")
        IF k% <= 5
            IF LEN(a$) > (k%+1)
                a$ = MID$(a$, k%+2, LEN(a$)-k%-1)
            ELSE
                a$ = ""
            END_IF
        END_IF
    END_IF
    FILE_WRITELN 1, a$
NEXT i%
FILE_CLOSE 1
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
impr:
FILE_SAVE fpr%, fm$
EXECUTE_WAIT "write.exe /p " + fm$
FILE_DELETE fm$
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
chp:
SHOW 96
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
cnl:
FILE_OPEN_WRITE 2, fn$
IF afl% = 0
    FOR nl% = 1 TO COUNT(fpr%)
        a$ = ITEM_READ$(fpr%, nl%)
        FILE_WRITELN 2, STRING$(4-LEN(STR$(nl%)), " ") + STR$(nl%) + ": " + a$
    NEXT nl%
    afl% = 1: CAPTION 42, "Suppr. N°s de lignes"
ELSE
    FOR nl% = 1 TO COUNT(fpr%)
        a$ = ITEM_READ$(fpr%, nl%)
        k% = INSTR(a$, ": ")
        IF k%<=5
            IF LEN(a$)>(k%+1)
                a$ = MID$(a$, k%+2, LEN(a$)-k%-1)
            ELSE
                a$ = ""
            END_IF
        END_IF
        FILE_WRITELN 2, a$
    NEXT nl%
    afl% = 0: CAPTION 42, "Numéros de lignes"
END_IF
FILE_CLOSE 2
CLEAR fpr%
FILE_LOAD fpr%, fn$: FILE_DELETE fn$
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
vfont:
CLEAR 100
IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97)
fsz% = POSITION(98)
FONT_NAME 100, font$: FONT_SIZE 100, fsz%
ITEM_ADD 100, font$
ITEM_ADD 100, "Voyez le Brick Géant Que J'examine Près du Wharf"
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
vlf:
IF ITEM_INDEX(97) > 0 THEN font$ = ITEM_INDEX$(97)
fsz% = POSITION(98)
FONT_NAME fpr%, font$: FONT_SIZE fpr%, fsz%
HIDE 96
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Misfo:
' Mise en forme de a$ avant analyse (élimination des éléments superflus)
ign% = 0
CAPTION flf%, STR$(nl%)+" / "+STR$(COUNT(fpr%))
IF afl% = 1
    k% = INSTR(a$, ":"): IF k% > 0 THEN a$ = MID$(a$, k%+1, LEN(a$))
END_IF
a$ = TRIM$(a$): IF a$ = "" THEN ign% = 1: RETURN
GOSUB Supquot: ' *** Éliminer les contenus éventuels entre quotes
' *** Éliminer les commentaires
IF a$ = "" OR LEFT$(LTRIM$(a$), 1) = CHR$(39) OR LEFT$(UPPER$(LTRIM$(a$)), 3) = "REM"
    ign% = 1: RETURN
END_IF
b$ = UPPER$(a$) + " ": k% = INSTR(b$, "REM ")
k% = INSTR(UPPER$(a$), "REM"): IF k% = 0 THEN k% = INSTR(a$, CHR$(39))
IF k% > 0
    IF MID$(a$, k%-1, 1) = " " OR MID$(a$, k%-1, 1) = ":"
        a$ = RTRIM$(LEFT$(a$, k%-2))
        IF a$ = "" THEN ign% = 1: RETURN
    END_IF
END_IF
IF RIGHT$(a$, 1) = ":" THEN a$ = LEFT$(a$, LEN(a$) - 1)
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Supquot:
' *** Éliminer les contenus entre quotes
k1% = 0: k2% = 0
FOR i% = 1 TO LEN(a$)-2
    IF MID$(a$, i%, 1) = CHR$(34) THEN k1% = i%: EXIT_FOR
NEXT i%
IF k1% > 0
    FOR i% = k1%+1 TO LEN(a$)
        IF MID$(a$, i%, 1) = CHR$(34) THEN k2% = i%: EXIT_FOR
    NEXT i%
    IF k2% > 0 THEN a$ = LEFT$(a$, k1%-1) + MID$(a$, k2%+1, LEN(a$)): GOTO Supquot
    a$ = LEFT$(a$, k1%-1): ' 2ème quote non trouvé
END_IF
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Listvar:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
' ***** VARIABLES DÉCLARÉES (DIM) *****************************************
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "      ****** LISTE DES VARIABLES ******"
ITEM_ADD fls%, ""
ITEM_ADD fls%, "            un moment svp..."
nvar% = 0
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    GOSUB Misfo: IF ign% = 1 THEN GOTO Suit1
ra:
    k% = INSTR(UPPER$(a$), "DIM ")
    IF k% > 0
        a$ = MID$(a$, k%+4, LEN(a$)-k%-3)
        k% = INSTR(a$, ":"): a1$ = ""
        IF k% > 0 THEN a1$ = MID$(a$, k%+1, LEN(a$)-k%): a$ = LEFT$(a$, k%-1)
       
        FOR i% = 1 TO LEN(a$)
            k1% = 0
            IF MID$(a$, i%, 1) = "("
                FOR j% = i%+1 TO LEN(a$)
                    IF MID$(a$, j%, 1) = ")"
                        FOR k% = i%+1 TO j%-1
                            IF MID$(a$, k%, 1) = ","
                                a$ = LEFT$(a$, i%-1)+"["+MID$(a$, i%+1, LEN(a$))
                                a$ = LEFT$(a$, k%-1)+"."+MID$(a$, k%+1, LEN(a$))
                                a$ = LEFT$(a$, j%-1)+"]"+MID$(a$, j%+1, LEN(a$))
                                k1% = 1: EXIT_FOR
                            END_IF
                        NEXT k%
                        EXIT_FOR
                    END_IF
                NEXT j%
            END_IF
        NEXT i%
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:
NEXT nl%
IF nvar% = 0 THEN GOTO Suit41
' remise en forme des déclarations de tableaux à double entrée
' (remplacement des crochets par des parenthèses et du point par virgule)
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%
' Tri alphabétique des résultats
DLIST 89: FOR i% = 1 TO nvar%: ITEM_ADD 89, var$(i%): NEXT i%
SORT 89: FOR i% = 1 TO nvar%: var$(i%) = ITEM_READ$(89, i%): NEXT i%
DELETE 89
' ajout des crochets autour des numéros de lignes (ligne de déclaration DIM)
FOR i% = 1 TO nvar%
    var$(i%) = LEFT$(var$(i%), LEN(var$(i%))-5) + " [" + TRIM$(RIGHT$(var$(i%),5)) + "]"
NEXT i%
' *****  RECHERCHE DES VARIABLES DANS LE CODE *******************************
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    GOSUB Misfo: IF ign% = 1 THEN GOTO Suit4
    k% = INSTR(UPPER$(a$), "DIM ")
    IF k% = 0 THEN k% = INSTR(UPPER$(a$), "LABEL ")
    IF k% > 0
        ' c'est une ligne de DIM ou de LABEL
        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
    k% = INSTR(UPPER$(a$), "LABEL")
    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:
NEXT nl%
Suit41:
HIDE flf%: CLEAR fls%
ITEM_ADD fls%, "      ****** LISTE DES VARIABLES ("+STR$(nvar%)+") ******"
ITEM_ADD fls%, ""
IF nvar% > 0
    FOR i% = 1 TO nvar%
        a$ = var$(i%): GOSUB Afl
    NEXT i%
END_IF
SHOW flf%
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$)
c$ = CHR$(254)
rf:
k% = INSTR(a$, v$): IF k% < 1 THEN ign% = 1: GOTO rcvs
s$ = CHR$(255)
IF k% > 1 THEN c$ = MID$(a$, k%-1,1): ' caractère précédent (si pas le 1er)
IF k% < (LEN(a$)-lv%+1) THEN s$ = MID$(a$, k%+lv%, 1): ' caractère suivant (si pas le dernier)
j% = 0
FOR i% = 1 TO tca%
    IF c$ = car$(i%) THEN j% = 1: EXIT_FOR
NEXT i%
IF j% = 0 THEN a$ = MID$(a$, k%+1, LEN(a$)): GOTO rf
j% = 0
FOR i% = 1 TO tca%
    IF s$ = car$(i%) THEN j% = 1: EXIT_FOR
NEXT i%
IF RIGHT$(v$, 1) <> "("
    IF j% = 0 THEN c$ = MID$(a$, k%, 1): a$ = MID$(a$, k%+1, LEN(a$)): GOTO rf
END_IF
' trouvé
rcvs:
a$ = sva$
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Afl:
k% = INSTR(a$, " "): b$ = MID$(a$, k%, LEN(a$)): a$ = LEFT$(a$, k%-1)
IF LEN(a$) < marg% THEN a$ = a$ + STRING$(marg%-LEN(a$), " ")
a$ = a$ + b$
rk:
IF LEN(a$) > nc%
    FOR j% = nc%+1 TO 0 STEP -1
        IF MID$(a$, j%, 1) = "," THEN EXIT_FOR
    NEXT j%
    ITEM_ADD fls%, LEFT$(a$, j%)
    a$ = STRING$(marg%+1, " ") + MID$(a$, j%+1, LEN(a$)-j%): GOTO rk
END_IF
ITEM_ADD fls%, a$
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Instrs:
' recherche de b$ dans a$ à partir de u% -> k1%
k1% = 0
IF u% <= LEN(a$)
    c$ = MID$(a$, u%, LEN(a$)-u%+1): k1% = INSTR(c$, b$)
    IF k1% > 0 THEN k1% = k1% + u% - 1
END_IF
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Mids:
' renvoie la chaîne b$, reste de a$ à partir de k% (y compris vide)
b$ = "": IF k% <= LEN(a$) THEN b$ = MID$(a$, k%, LEN(a$)-k%+1)
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Reclab:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "      ****** LISTE DES LABELS ******"
ITEM_ADD fls%, ""
ITEM_ADD fls%, "            un moment svp..."
neti% = 0
' *****  ÉTIQUETTES DÉCLARÉES (LABEL) ***********************************
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = 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:
NEXT nl%
IF neti% = 0 THEN GOTO Suit51
FOR i% = 1 TO neti%
    eti$(i%) = LEFT$(eti$(i%), LEN(eti$(i%))-5) + " [" + TRIM$(RIGHT$(eti$(i%),5)) + "]"
NEXT i%
' Tri alphabétique du résultat
DLIST 89: FOR i% = 1 TO neti%: ITEM_ADD 89, eti$(i%): NEXT i%
SORT 89: FOR i% = 1 TO neti%: eti$(i%) = ITEM_READ$(89, i%): NEXT i%
DELETE 89
' ***** RECHERCHE DES APPELS AUX LABELS DANS LE CODE ************************
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = 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:
NEXT nl%
Suit51:
HIDE flf%
CLEAR fls%: ITEM_ADD fls%, "      ****** LISTE DES LABELS ("+STR$(neti%)+") ******"
ITEM_ADD fls%, ""
IF neti% > 0
    FOR i% = 1 TO neti%
        a$ = eti$(i%): GOSUB Afl
    NEXT i%
END_IF
SHOW flf%
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) <> " " AND 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
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Recobj:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
' ***** OBJETS DÉCLARÉS *******************************************
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "      ****** LISTE DES OBJETS ******"
ITEM_ADD fls%, ""
ITEM_ADD fls%, "            un moment svp..."
nobj% = 0
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    GOSUB Misfo: IF ign% = 1 THEN GOTO Suit3
    a$ = UPPER$(a$)
    k% = INSTR(a$, "DATA ")
    IF k% > 0 THEN GOSUB Supelem: IF ign% = 1 THEN GOTO Suit3
    k% = INSTR(a$, "DIM ")
    IF k% > 0 THEN GOSUB Supelem: IF ign% = 1 THEN GOTO Suit3
    k% = INSTR(a$, "LABEL ")
    IF k% > 0 THEN GOSUB Supelem: IF ign% = 1 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:
NEXT nl%
' Tri du résultat
DLIST 89: FOR i% = 1 TO nobj%: ITEM_ADD 89, obj$(i%): NEXT i%
SORT 89: FOR i% = 1 TO nobj%: obj$(i%) = ITEM_READ$(89, i%): NEXT i%
DELETE 89
HIDE flf%
CLEAR fls%
ITEM_ADD fls%, "      ****** LISTE DES OBJETS ("+STR$(nobj%)+") ******"
ITEM_ADD fls%, ""
FOR i% = 1 TO nobj%: ITEM_ADD fls%, obj$(i%): NEXT i%
SHOW flf%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Recif:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "      ****** LISTE DES IF...ELSE...END_IF  ******"
ITEM_ADD fls%, "": WAIT 10
indt% = 0: ' indentation
FOR nl% = 1 TO COUNT(fpr%)
    CAPTION flf%, STR$(nl%)+" / "+STR$(COUNT(fpr%))
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    IF afl% = 1
        k% = INSTR(a$, ":"): a$ = MID$(a$, k%+1, LEN(a$)-k%)
    END_IF
    IF LEN(a$) < 4 THEN GOTO Suit6
    a$ = UPPER$(TRIM$(a$)): IF a$ = "" THEN GOTO Suit6
    k% = INSTR(a$, ":")
    IF k% > 0
        k1% = 0
        FOR i% = 1 TO k%-1
            IF MID$(a$, i%, 1) = " " THEN k1% = 1: EXIT_FOR
        NEXT i%
        IF k1% = 0 AND k% = LEN(a$)
            ITEM_ADD fls%, RTRIM$(sva$)+" *****"
            indt% = 0: GOTO Suit6: ' étiquette
        END_IF
    END_IF
    IF LEFT$(a$, 6) = "RETURN" OR LEFT$(a$, 9) = "TERMINATE"
        ITEM_ADD fls%, RTRIM$(sva$)+" "+STRING$(nc%-12, "-")
        indt% = 0: GOTO Suit6
    END_IF
    GOSUB Supquot: ' suppression des expressions entre quotes
    k% = INSTR(a$, CHR$(39)): IF k% = 1 THEN GOTO Suit6
    IF k% > 0 THEN a$ = LEFT$(a$, k%-1): IF TRIM$(a$) = "" THEN GOTO Suit6
    k% = INSTR(a$, "REM"): IF k% = 1 THEN GOTO Suit6
    IF k% > 0 THEN a$ = LEFT$(a$, k%-1): IF TRIM$(a$) = "" THEN GOTO Suit6
    k% = INSTR(a$, "IF ")
    IF k%>0
        IF k% = 1
            GOSUB Ecsva
            k% = INSTR(a$, "THEN "): IF k% < 1 THEN indt% = indt% + 4
            GOTO Suit6
        END_IF
        IF k% > 1 THEN c$ = MID$(a$, k%-1, 1)
        IF c$=" " OR c$<>":"THEN GOSUB Ecsva: GOTO Suit6
    END_IF
    k% = INSTR(a$, "ELSE")
    IF k% = 1 THEN indt%=indt%-4: GOSUB Ecsva: indt% = indt% + 4: GOTO Suit6
    k% = INSTR(a$, "END_IF")
    IF k% = 1 THEN indt% = indt%-4: GOSUB Ecsva
Suit6:
NEXT nl%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Ecsva:
c$ = "": IF indt% > 0 THEN c$ = STRING$(indt%, " ")
IF afl% = 1
    k% = INSTR(sva$, ":"): c$ = LEFT$(sva$, k%+1)+c$: sva$ = MID$(sva$, k%+2, LEN(sva$))
END_IF
ITEM_ADD fls%, c$ + TRIM$(sva$)
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Recwhile:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "      ****** LISTE DES WHILE...END_WHILE ******"
ITEM_ADD fls%, "": WAIT 10
indt% = 0: ' indentation
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    GOSUB Misfo: IF ign% = 1 THEN GOTO Suit7
    a$ = TRIM$(UPPER$(a$))
    k% = INSTR(a$, "WHILE "): k1% = INSTR(a$, "END_WHILE")
    IF k%>0 OR k1%>0 THEN ITEM_ADD fls%, sva$
Suit7:
NEXT nl%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Recrep:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "      ****** LISTE DES REPEAT...UNTIL ******"
ITEM_ADD fls%, "": WAIT 10
indt% = 0: ' indentation
FOR nl% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    GOSUB Misfo: IF ign% = 1 THEN GOTO Suit8
    a$ = TRIM$(UPPER$(a$))
    k% = INSTR(a$, "REPEAT"): k1% = INSTR(a$, "UNTIL ")
    IF k%>0 OR k1%>0 THEN ITEM_ADD fls%, sva$
Suit8:
NEXT nl%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Supelem:
' suppression d'un élément
ign% = 0
u% = k%+1: b$ = ":": GOSUB Instrs
IF k1% = 0
    a$ = LEFT$(a$, k%-1)
ELSE
    a$ = LEFT$(a$, k%-1) + MID$(a$, k1%+1, LEN(a$))
END_IF
IF a$ = "" THEN ign% = 1
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Recsou:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
CLEAR fls%: SHOW flf%: ITEM_ADD fls%, "    ****** LISTE DES SOUS-PROGRAMMES ET LABELS ******"
ITEM_ADD fls%, ""
FOR nl% = 1 TO COUNT(fpr%)
    CAPTION flf%, STR$(nl%)+" / "+STR$(COUNT(fpr%))
    a$ = ITEM_READ$(fpr%, nl%): sva$ = a$
    IF afl% = 1
        k% = INSTR(a$, ":"): a$ = MID$(a$, k%+1, LEN(a$)-k%)
    END_IF
    IF LEN(a$) < 4 THEN GOTO Suit9
    a$ = UPPER$(TRIM$(a$)): IF a$ = "" THEN GOTO Suit9
    k% = INSTR(a$, ":")
    IF k% > 0
        IF LEN(RTRIM$(a$)) > k% THEN GOTO Suit9
        k1% = 0
        FOR i% = 1 TO k%-1
            IF MID$(a$, i%, 1) = " " THEN k1% = 1: EXIT_FOR
        NEXT i%
        IF k1% = 0
            ITEM_ADD fls%, RTRIM$(sva$)
            GOTO Suit9: ' étiquette
        END_IF
    END_IF
    IF LEFT$(a$, 6) = "RETURN" OR LEFT$(a$, 9) = "TERMINATE"
        ITEM_ADD fls%, RTRIM$(sva$)
        ITEM_ADD fls%, "----------------"
        GOTO Suit9
    END_IF
Suit9:
NEXT nl%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Recseq:
IF COUNT(fpr%) = 0 THEN GOSUB Charsou: RETURN
s$ = MESSAGE_INPUT$("Recherche séquence","Séquence cherchée:","")
IF s$ = "" THEN RETURN
FOR i% = 1 TO COUNT(fpr%): ll%(i%) = LEN(ITEM_READ$(fpr%, i%))+2: NEXT i%
FOR i% = 1 TO COUNT(fpr%)
    a$ = ITEM_READ$(fpr%, i%)
    k% = INSTR(UPPER$(a$), UPPER$(s$))
    IF k% > 0
        n% = 0
        FOR j% = 1 TO i%-1: n% = n% + ll%(j%): NEXT j%
        ' SELECT_TEXT fpr%, n%+k%, LEN(s$)
        b$ = "- Séquence cherchée: " + chr$(34)+s$ + chr$(34)+" -"+chr$(10)
        b$ = b$ + "============================="+chr$(10)+a$
        b$ = b$ + chr$(10)+ "============================="
        b$ = b$ + chr$(10)+"            - Suivant ? -"
        IF MESSAGE_CONFIRMATION_YES_NO(b$ ) <> 1 THEN RETURN
    END_IF
NEXT i%
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Charsou:
MESSAGE "Pas de programme source à analyser !"
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
Debug:
MESSAGE "Erreur ligne: " + str$(error_line)+" " + error_type$
TERMINATE
RETURN
' +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-

b$ = MID$(a$, k%, LEN(a$)-k%+1)

b$=MID$(a$,k%+1,300)

dim i%
label lab_sub, lab_goto1, lab_goto2


i% = 0

lab_goto2:
if i%>10
    print "limite atteinte"
else
    i% = i% + 1
    gosub lab_sub
    goto lab_goto1
lab_sub:
    print "lab_sub ";i%
    return
lab_goto1:
    print "lab_goto1"
    goto lab_goto2
end_if

print "fin ";i%

end

Gosub toto
...
Gosub tata
...
...
End
toto:
...
tata:
...
Return

  46: alpha 6
  47: left 6,30 : top 6,275
  48: font_bold 6 : font_size 6,10 : color 6,0,255,0
  49: a$="              Cliquez ici pour                "
  50: a$=a$+chr$(13)+"            agrandir le tableau            "
  51: caption 6,a$
  52: on_click 6,agran

  76: agran:
  77: it=it+1
  78: if it>1 then it=0
  79: if it=1
  80:    y=470 : height 0,y
  ...........

 110: hist:
 111: file_open_read 1,"Adresses.txt"
 112:    file_readln 1,d$
 113:    file_readln 1,f$
 114: file_close 1
 115: if d$<>date$
    .........

 122:  if f$="1"
 123:    file_open_write 1,"Adresses.txt"
 124:      file_writeln 1,d$
 125:      file_writeln 1,2
 126:    file_close 1
 127:    a$="Deux histoires le même jour !"+chr$(13)+"Dites donc, votre moral est"
 128:    a$=a$+chr$(13)+"vraiment bas, aujourd'hui !"
 129:    message a$
 130:    execute "ADR-STORY-07.EXE"
 131:  else
 132:    a$="Trois histoires le même jour !?!"+chr$(13)+"Ce n'est plus de la déprime, ça,"
 133:    a$=a$+chr$(13)+"c'est de la gourmandise."+chr$(13)+"Désolé !"
 134:    message a$
 135:  end_if