' *****************************************
' * RECHERCHE de MOTS POUR CRUCIVERBISTES *  ----->  C:\DICO\CHER_MOT.BAS
' *****************************************
' Ecrit par SFLPMEA le 15/01/2010
    OPTION BASE 1: DEFSTR A-Z: CLOSE
    SCREEN 12: WINDOW SCREEN (1, 1)-(640, 480): CLS
  
    Cfd% = 0               ' COUL DE FOND ECRAN
    Ccv% = 11              ' COUL CADRE VIDE
    Cct% = 10: Cte% = 14   ' COUL CADRE/TITRE
    Cdd% = 11              ' COUL DESIGNATIONS DONNEES
    Cdav% = 13             ' COUL DONNEES AVT SAISIE
    Cdas% = 14             ' COUL DONNEES … SAISIR
    Cds% = 15              ' COUL DONNEES APRES SAISIE
   
    BVR& = 65536 * 5 + 256 * 5 + 5
    PALETTE 0, BVR&
    K% = 11: GOSUB GS00.CADRE
    DIM Lettre&(400), LX&(65 TO 90, 400), Largeur%(90), G&(73)
    Largeur%(32) = 30  ' ***** Modifiable
    'GOTO AAAAA
    ' ***** Chargement des Tables 'caracteres' de A … V
    FOR ASKI% = 65 TO 86
        L = CHR$(ASKI%)
        OPEN "C:\ALPHABET\CES40VAR\L_" + L + ".LET" FOR INPUT AS #1
        FOR I% = 1 TO 400: INPUT #1, LX&(ASKI%, I%): NEXT I%
        INPUT #1, Largeur%(ASKI%): CLOSE
    NEXT ASKI%
   
    ' ***** LIGNE 1
    Ecri = "RECHERCHES"      ' ***** Modifiable
    Y% = 113: GOSUB GS02.AFFICHE
   
    ' ***** LIGNE 2
    Ecri = "POUR LES"       ' ***** Modifiable
    Y% = 213: GOSUB GS02.AFFICHE
   
    ' ***** LIGNE 3
    Ecri = "MOTS CROISES"   ' ***** Modifiable
    Y% = 313: GOSUB GS02.AFFICHE
    ' *****
    LOCATE 26, 13: COLOR 15: PRINT " VERSION 1.0 "
    Debut# = TIMER: RANDOMIZE TIMER
    ' ***** Clignottement
    DO
    FOR Y% = 133 TO 333 STEP 100: FOR X% = 30 TO 600 STEP 8
        K% = INT(RND * 8) + 8: IF K% < 9 THEN K% = K% + 1
            IF POINT(X%, Y%) > 0 THEN PAINT (X%, Y%), K%, 0
    NEXT X%, Y%
    LOOP UNTIL TIMER > Debut# + 5 OR INKEY$ > ""
    ' ***** Effacement ecran
    Xc% = INT(RND * 214) + 214: Yc% = INT(RND * 161) + 160
    K% = INT(RND * 16)
    RANDOMIZE TIMER: K% = INT(RND * 16)
    FOR X% = 320 TO 1 STEP -1: LINE (Xc%, Yc%)-(X%, 1), K%: NEXT X%
    FOR Y% = 1 TO 480: LINE (Xc%, Yc%)-(1, Y%), K%: NEXT Y%
    FOR X% = 1 TO 640: LINE (Xc%, Yc%)-(X%, 480), K%: NEXT X%
    FOR Y% = 480 TO 1 STEP -1: LINE (Xc%, Yc%)-(640, Y%), K%: NEXT Y%
    FOR X% = 640 TO 320 STEP -1: LINE (Xc%, Yc%)-(X%, 1), K%: NEXT X%
AAAAA:
    K% = 11: GOSUB GS00.CADRE
    Titre = "  RECHERCHES POUR MOTS CROISES  "
    L% = 3: GOSUB GS08.GAUCHE: Cr% = 4: GOSUB GS08.REMPLI
    Titre = " Les voyelles sont accentu‚es "
    L% = 6: C% = 6: GOSUB GS08.TITRE: Cr% = 1: GOSUB GS08.REMPLI
    LOCATE 3, 48: COLOR 11: PRINT "R‚sultats de la Recherche"
    GOSUB GS21.OPEN: Nb.Mots& = LOF(1) / 32
    OPEN "C:\DICO\SELECTIO.DIC" FOR RANDOM AS #2 LEN = 28' (Nf2&)
    FIELD #2, 27 AS F.Sel
   
A01.NOUVEAU: ' ***** Nouvelle recherhe
    Lchg% = 5: Cchg% = 3: Lcbd% = 28: Ccbd% = 39
    Ccv% = Cct%: GOSUB GS09.CV
    Lchg% = 2: Cchg% = 41: Lcbd% = 28: Ccbd% = 78
    Ccv% = Cct%: GOSUB GS09.CV
    FOR L% = 9 TO 27: LOCATE L%, 4: PRINT SPACE$(35): NEXT L%
    FOR L% = 4 TO 27: LOCATE L%, 42: PRINT SPACE$(36): NEXT L%
    Lchg% = 9: Cchg% = 6: Lcbd% = 12: Ccbd% = 37: GOSUB GS09.CV
    LOCATE 10, 10: COLOR Cte%: PRINT "A Rechercher ...."
    LOCATE 13, 5: PRINT "'0000' pour Sortir"
    LOCATE 14, 5: PRINT "Fournir Lettres en leur Position"
    ' ***** A Rechercher
    L% = 11: C% = 20: Nbc% = 15: S.Pr = S.Pr1: GOSUB GS07.ALPHA
    IF LEFT$(Saisie, 4) = "0000" GOTO E03.CEFINI
    LOCATE 11, 19: PRINT "*" + Saisie + "*": S.Pr1 = S
    Lchg% = 15: Cchg% = 6: Lcbd% = 18: Ccbd% = 37: GOSUB GS09.CV
    LOCATE 16, 10: COLOR 14: PRINT "Mots Lus ......"
    LOCATE 17, 10: PRINT "S‚lectionn‚s..."
    LOCATE 16, 30: COLOR 13: PRINT USING "######"; Nb.Mots&
    A.Rech = RTRIM$(Saisie): A.R% = LEN(A.Rech): Nbc% = 0
    LOCATE 26, 5: PRINT "*" + A.Rech + "*"
    COLOR 12: LOCATE 4, 49: PRINT "*" + A.Rech + "*"
    FOR P% = 1 TO A.R%
        IF MID$(A.Rech, P%, 1) > " " THEN
            Nbc% = Nbc% + 1
        END IF
    NEXT
    IF Nbc% < 2 THEN
        M = " Donnez-moi au moins 2 CaractŠres ...... (Presser Espace)"
        GOSUB GS05.ERREUR: GOTO A01.NOUVEAU
    END IF
    Nf2& = 0: Debut! = TIMER
    FOR Nf1& = 1 TO Nb.Mots&
        GOSUB GS21.LECTURE
        'LOCATE 16, 21: COLOR 11: PRINT USING "###### /"; Nf1&
        ' ***** LA LIGNE CI-DESSUS RALENTIT TERRIBLEMENT L'EXECUTION
        IF Nf1& MOD 500 = 0 THEN
            LOCATE 16, 21: COLOR 11: PRINT USING "###### /"; Nf1&
        END IF
        Mot = RTRIM$(Mot): Lg.Mot% = LEN(Mot): Correct = "OUI"
        IF Lg.Mot% >= Nbc% THEN
            FOR P% = 1 TO A.R%
                ' A.R% est la longueur de la recherche
                ' A.Rech est la recherche … faire dans Mot
                IF MID$(A.Rech, P%, 1) > " " THEN
                  ' ***** Dans cette position, pas de caractere
                  IF MID$(A.Rech, P%, 1) <> MID$(Mot, P%, 1) THEN
                    ' *** Le caractŠre est diff‚rent
                    Correct = "NON": EXIT FOR
                  END IF
                END IF
            NEXT P%
           
            IF Correct = "OUI" THEN
                Nf2& = Nf2& + 1
                LOCATE 17, 30: COLOR 13: PRINT USING "######"; Nf2&
                LSET F.Sel = Mot: PUT #2, Nf2&
                'LOCATE 27, 5: PRINT "-" + F.Sel': SLEEP 1
            END IF
        END IF
    NEXT Nf1&
    LOCATE 16, 21: COLOR 11: PRINT USING "###### /"; Nf1& - 1
    LOCATE 28, 5: COLOR 15: PRINT USING "####.##"; TIMER - Debut!
    IF Nf2& = 0 THEN
        Titre = "   AUCUN MOT DE SELECTIONNE !!   "
        L% = 20: GOSUB GS08.GAUCHE: Cr% = 4: GOSUB GS08.REMPLI
        SLEEP 5: GOTO A01.NOUVEAU
    END IF
    Lchg% = 19: Cchg% = 6: Lcbd% = 21: Ccbd% = 37: GOSUB GS09.CV
    LOCATE 20, 10: COLOR 14: PRINT "Affichage (0 si oui)"
    L% = 20: C% = 31: Nbc% = 1: S.Pr = "0":  GOSUB GS07.ALPHA
    Nf2.Tot& = Nf2&
    IF Saisie <> "0" GOTO A01.NOUVEAU
    LOCATE 22, 5: PRINT "Presser '*' pour autre recherche"
    LOCATE 23, 5: PRINT "TOUTES fleches pour se d‚placer"
    LOCATE 24, 5: PRINT "'-' pour 500 AVANT"
    LOCATE 25, 5: PRINT "'+' pour 500 APRES"
    NE2H& = 1: GOSUB A01.AFFICHAGE: GOTO A02.OPTION

A01.AFFICHAGE: L% = 4: NE2H.PR& = NE2H&
  
    FOR NE2H& = NE2H& TO NE2H& + 22
        Nf2& = NE2H&: L% = L% + 1: GET #2, Nf2&
        IF Nf2& <= Nf2.Tot& THEN
            COLOR 11: LOCATE L%, 42: PRINT USING "#######"; Nf2&
            COLOR 15: LOCATE L%, 50: PRINT F.Sel
        ELSE
            LOCATE L%, 42: PRINT SPACE$(7)
            LOCATE L%, 50: PRINT SPACE$(25)
        END IF
    NEXT NE2H&
    NE2H& = NE2H.PR&
    RETURN

A02.OPTION: K = INKEY$: IF K = "" GOTO A02.OPTION
    SELECT CASE K
        CASE CHR$(27):         
E03.CEFINI:  COLOR 15: CLOSE : KILL "C:\DICO\SELECTIO.DIC"
                                K% = 10: GOSUB GS00.CADRE
                                ' ***** LIGNE 1
                                Ecri = "CRUCIVERBISTE"
                                Y% = 113
                                GOSUB GS02.AFFICHE
                                ' ***** LIGNE 2
                                Ecri = "AU REVOIR"
                                Y% = 213
                                GOSUB GS02.AFFICHE
                                ' ***** LIGNE 3
                                Ecri = "A BIENTOT"
                                Y% = 313
                                GOSUB GS02.AFFICHE
                               
                                END

        CASE "*", "æ":          GOTO A01.NOUVEAU
        CASE CHR$(0) + "H":     NE2H& = NE2H& - 1
        CASE CHR$(0) + "I":     NE2H& = NE2H& - 23
        CASE CHR$(0) + "P":     NE2H& = NE2H& + 1
        CASE CHR$(0) + "Q":     NE2H& = NE2H& + 23
        CASE "-":               NE2H& = NE2H& - 500
        CASE "+":               NE2H& = NE2H& + 500
        CASE ELSE:              GOTO A02.OPTION
    END SELECT
    IF NE2H& < 1 THEN NE2H& = 1: BEEP
    IF NE2H& > Nf2.Tot& THEN NE2H& = Nf2.Tot&: BEEP
    GOSUB A01.AFFICHAGE: GOTO A02.OPTION

GS00.CADRE: CLS
    LINE (1, 1)-(640, 464), 0, BF
    FOR I% = 1 TO 16: LINE (I%, I%)-(I%, 232), K%, , 32752: NEXT I%
    Y% = 234
    FOR X% = 1 TO 16: Y% = Y% - 1: LINE (X%, Y%)-(X%, 464), K%, , 4095: NEXT X%
    FOR I% = 1 TO 16: LINE (I%, I%)-(320, I%), K%, , 32752: NEXT I%
    X% = 322
    FOR Y% = 1 TO 16: X% = X% - 1: LINE (X%, Y%)-(640, Y%), K%, , 4095: NEXT Y%
    Y% = 465
    FOR X% = 1 TO 16: Y% = Y% - 1: LINE (X%, Y%)-(320, Y%), K%, , 32752: NEXT X%
    X% = 322: Y% = 465
    FOR I% = 1 TO 16: X% = X% - 1: Y% = Y% - 1
        LINE (X%, Y%)-(640, Y%), K%, , 4095
    NEXT I%
    X% = 641
    FOR Y% = 1 TO 16: X% = X% - 1: LINE (X%, Y%)-(X%, 232), K%, , 32752: NEXT Y%
    X% = 641: Y% = 234
    FOR I% = 1 TO 16: X% = X% - 1: Y% = Y% - 1
        LINE (X%, Y%)-(X%, 464), K%, , 4095
    NEXT I%
    K% = 12
    LINE (1, 1)-(24, 24), K%, B: LINE (1, 1)-(24, 24), K%
    LINE (1, 24)-(24, 1), K%: PAINT (6, 12), K%, K%
    PAINT (12, 6), K%, K%: PAINT (18, 12), K% - 8, K%
    PAINT (12, 18), K% - 8, K%: LINE (1, 1)-(12, 12), 15
    GET (1, 1)-(24, 24), G&: PUT (1, 220), G&, PSET
    PUT (1, 441), G&, PSET: PUT (308, 1), G&, PSET
    PUT (308, 441), G&, PSET: PUT (617, 1), G&, PSET
    PUT (617, 220), G&, PSET: PUT (617, 441), G&, PSET
    RETURN

GS02.AFFICHE: Lg% = 0: Espace% = 10
    FOR P% = 1 TO LEN(Ecri)
        L = MID$(Ecri, P%, 1): L% = ASC(L)
        IF L >= "A" AND L <= "V" THEN
            Lg% = Lg% + Largeur%(L%) + Espace%
        ELSE
            Lg% = Lg% + Espace% * 5
        END IF
    NEXT P%
    Lg% = Lg% - Espace%: X% = 320 - Lg% / 2
    Y1% = Y% - 20: Y2% = Y1% + 80
    X1% = 320 - Lg% / 2 - 20: X2% = 320 + Lg% / 2 + 20
    LINE (X1%, Y1%)-(X2%, Y2%), 12, BF
    Y3% = Y1% + 7: Y4% = Y2% - 7: X3% = X1% + 7: X4% = X2% - 7
    LINE (X3%, Y3%)-(X4%, Y4%), 0, BF
    FOR P% = 1 TO LEN(Ecri)
        L = MID$(Ecri, P%, 1): L% = ASC(L)
            IF L >= "A" AND L <= "V" THEN
                FOR A% = 1 TO 400
                    Lettre&(A%) = LX&(L%, A%)
                NEXT A%
                PUT (X%, Y%), Lettre&, PSET
                X% = X% + Largeur%(L%) + Espace%
            ELSE
                X% = X% + Espace% * 5
            END IF
    NEXT P%
    RETURN

GS02.ESPACE: M = "Appuyez sur la TOUCHE ESPACE pour POURSUIVRE"
    GOTO GS05.ERREUR
GS03.BIP: FOR B% = 1 TO 2: PLAY "O2 L32 CC+DD+EFF+": NEXT B%
    RETURN
GS04.SIRENE: FOR Z% = 500 TO 100 STEP -5: SOUND Z%, Z% / 5000: NEXT Z%
    RETURN
' ***** AFFICHAGE MESSAGE en Ligne 30
GS05.ERREUR: Col.Er% = 40 - LEN(M) / 2: GOSUB GS04.SIRENE
    LOCATE 30, Col.Er%: COLOR 14: PRINT M; : GOSUB GS06.ATTENTE
    LOCATE 30, 1: PRINT SPACE$(80);
    RETURN
GS06.ATTENTE: K = INKEY$: IF K = "" GOTO GS06.ATTENTE
    IF K = CHR$(27) THEN COLOR 15: END
    IF K <> " " GOTO GS06.ATTENTE
    RETURN

GS07.ALPHA: ' ***** SAISIE ALPHANUMERIQUE
    Lsp% = LEN(S.Pr): IF Lsp% < Nbc% THEN S.Pr = S.Pr + SPACE$(Nbc% - Lsp%)
    P% = 0: S = S.Pr
    Xhg% = (C% - 1) * 8 - 1: Yhg% = (L% - 1) * 16 - 1
    Xbd% = Xhg% + Nbc% * 8 + 2: Ybd% = Yhg% + 18
    LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 12, B
GS07A: COLOR 15: LOCATE L%, C%: PRINT S
    COLOR 12: LOCATE L%, C% + P%: PRINT MID$(S, P% + 1, 1);
    IF MID$(S, P% + 1, 1) = " " THEN LOCATE L%, C% + P%: PRINT CHR$(14);
GS07B: ' ***** Clignottement
    SELECT CASE INT(TIMER * 10) MOD 4
        CASE 0: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 12, B, &HF0F0
        CASE 1: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 13, B, &H7878
        CASE 2: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 14, B, &H3636
        CASE 3: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), 15, B, &HF0F0
    END SELECT
    K = INKEY$: IF K = "" GOTO GS07B
    SELECT CASE K
        CASE CHR$(3), CHR$(27):
            CLS : COLOR 15: END     'CTRL + C ou ECHAP
        CASE CHR$(0) + "K" '… Gauche
            IF P% = 0 THEN GOSUB GS04.SIRENE: GOTO GS07B
            P% = P% - 1: GOTO GS07A
        CASE CHR$(0) + "M" '… Droite
            IF P% = Nbc% THEN GOSUB GS04.SIRENE: GOTO GS07B
            P% = P% + 1: GOTO GS07A
        CASE CHR$(13) 'Entr‚e
            IF P% = 0 THEN S = S.Pr: GOTO GS07D ELSE GOTO GS07C
        CASE CHR$(0) + "R" ' Insertion case blanche
            IF RIGHT$(S, 1) <> " " THEN GOSUB GS04.SIRENE
            S = LEFT$(S, P%) + " " + RIGHT$(S, Nbc% - P%)
            S = LEFT$(S, Nbc%): GOTO GS07A
        CASE CHR$(0) + "S" ' Suppression
            S = LEFT$(S, P%) + RIGHT$(S, Nbc% - P% - 1) + " ": GOTO GS07A
        CASE CHR$(0) + "G" ' Retour au D‚but
            P% = 0: GOTO GS07A
        CASE CHR$(0) + "O" ' … la fin
            P% = LEN(RTRIM$(S)): GOTO GS07A
        CASE CHR$(8) ' Effacement caractŠre pr‚c‚dent
            IF P% = 0 THEN GOSUB GS04.SIRENE: GOTO GS07B
            IF P% = 1 THEN
                S = RIGHT$(S, Nbc% - 1) + " "
            ELSE
                S = LEFT$(S, P% - 1) + RIGHT$(S, Nbc% - P%) + " "
            END IF
            P% = P% - 1: GOTO GS07A
        CASE CHR$(9), CHR$(29)
            GOSUB GS03.BIP: GOTO GS07A
        CASE ELSE
            P% = P% + 1
            IF P% > Nbc% THEN GOSUB GS04.SIRENE: P% = Nbc%: GOTO GS07A
            MID$(S, P%, 1) = K: GOTO GS07A
    END SELECT
GS07C: IF P% = Nbc% GOTO GS07D
    Pk% = INSTR(S, "æ"): IF Pk% = 0 THEN Pk% = INSTR(S, "*")
    IF Pk% > 0 THEN S = LEFT$(S, Pk% - 1)
    Ls% = LEN(S): IF Ls% < Nbc% THEN S = S + SPACE$(Nbc% - Ls%)
GS07D: LOCATE L%, C%: COLOR Cds%: PRINT S
    Saisie = S: LINE (Xhg%, Yhg%)-(Xbd%, Ybd%), Cfd%, B
    RETURN

' ***** TITRE ENTOURE d'un CADRE *****
GS08.GAUCHE: L% = L% - 1: C% = 4: GOTO GS08.TITRE
GS08.CENTRE: L% = L% - 1: C% = 39 - LEN(Titre) / 2: GOTO GS08.TITRE
GS08.DROIT: L% = L% - 1: C% = 76 - LEN(Titre)
GS08.TITRE: Lg% = LEN(Titre): COLOR Cct%
    LOCATE L%, C%: PRINT "É"; STRING$((Lg%), "Í"); "»"
    LOCATE L% + 1, C%: PRINT "º": LOCATE L% + 1, C% + Lg% + 1: PRINT "º"
    LOCATE L% + 2, C%: PRINT "È"; STRING$((Lg%), "Í"); "¼"
    LOCATE L% + 1, C% + 1: COLOR Cte%: PRINT Titre;
    RETURN
GS08.REMPLI: Xg% = C% * 8: Xd% = (C% + Lg%) * 8 + 1
    Yh% = (L%) * 16 - 6: Yb% = Yh% + 26
    FOR X% = Xg% TO Xd%: FOR Y% = Yh% TO Yb%
        IF POINT(X%, Y%) = 0 THEN PSET (X%, Y%), Cr%
    NEXT Y%, X%
    RETURN
GS08.ENCADRE: Xchg% = (Cc% - 1) * 8 + 1: Ychg% = (Lc% - 1) * 16 + 1
    Xcbd% = (Cc% + Nc% - 1) * 8: Ycbd% = Ychg% + 14: Kc% = 15
    LINE (Xchg%, Ychg%)-(Xcbd%, Ycbd%), Kc%, B, &H3333
    LINE (Xchg%, Ychg%)-(Xcbd%, Ycbd%), 12, B, &HCCCC
    RETURN

' ***** AFFICHAGE CADRE VIDE *****
GS09.CV: COLOR Ccv%
    LOCATE Lchg%, Cchg%: PRINT "É"; STRING$((Ccbd% - Cchg% - 1), "Í"); "»"
    LOCATE Lcbd%, Cchg%: PRINT "È"; STRING$((Ccbd% - Cchg% - 1), "Í"); "¼"
    FOR L% = Lchg% + 1 TO Lcbd% - 1
        LOCATE L%, Cchg%: PRINT "º": LOCATE L%, Ccbd%: PRINT "º"
    NEXT L%
    RETURN

' ***** FICHIER Dictionnaire (DIC1.DIC pour le petit)
GS21.OPEN: OPEN "C:\DICO\DIC2.DIC" FOR RANDOM AS #1 LEN = 32
    FIELD #1, 31 AS F.Mot, 1 AS F.Sup
    RETURN
GS21.LECTURE: GET #1, Nf1&
    Mot = F.Mot: Sup = F.Sup
    RETURN