'**************************
'*  Une Balle qui Tourne  *  C:\\......\\V!!BALLE.BAS
'**************************
    CLS : OPTION BASE 1: SCREEN 12: WINDOW SCREEN (1, 1)-(640, 480)
    DEFSTR A-Z
    DIM T.Balle&(400) ' *** Une table/"dessin" peut ˆtre SURdimensionn‚e
 
    ON ERROR GOTO E99.ERREUR
 
' ** Chiffres, signes MOINS & POINT
    DIM C0&(76), C1&(76), C2&(76), C3&(76), C4&(76), C5&(76)
    DIM C6&(76), C7&(76), C8&(76), C9&(76), CM&(76), CP&(76)
    DIM G&(73)
    OPEN "C:\\ALPHABET\\ALPH1825\\C_0.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C0&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_1.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C1&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_2.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C2&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_3.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C3&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_4.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C4&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_5.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C5&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_6.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C6&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_7.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C7&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_8.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C8&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_9.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, C9&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_M.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, CM&(I%): NEXT I%: CLOSE
    OPEN "C:\\ALPHABET\\ALPH1825\\C_P.LET" FOR INPUT AS #1
    FOR I% = 1 TO 76: INPUT #1, CP&(I%): NEXT I%: CLOSE
    
' *** Couleurs utilis‚es
    Cct% = 11 ' Couleur Cadre Titre
    Cte% = 15 ' Couleur Titre Ecriture
    Ccv% = 11 ' Couleur Cadre Vide
    Ccf% = 13 ' Couleur Cadre fenetre
 
' *** Titres
    Titre = " * * E X E M P L E * * * "
    L% = 3: GOSUB F06G: Cr% = 4: GOSUB F06.REMPLI
    Titre = " * * * Q B A S I C * * * "
    L% = 3: GOSUB F06D: GOSUB F06.REMPLI
    Titre = " * Une Balle qui TOURNE * "
    L% = 6: GOSUB F06G: Cr% = 1: GOSUB F06.REMPLI
   
' *** Dur‚e du tour
    Titre = " Dur‚e du 'TOUR' Complet  " + SPACE$(15)
    L% = 5: C% = 34: Cct% = 11: GOSUB F06.TITRE
    Yddt% = 76  ' Ligne sup‚rieure affichage de la dur‚e du tour
               ' (Passage au NORD)
    Xddt% = 460 ' Abscisse gauche affichage
    D.d.T.PR = SPACE$(7)
   
' *** Possibilit‚s de Commandes
    Lchg% = 8: Cchg% = 4: Lcbd% = 22: Ccbd% = 31
    Ccv% = 11: GOSUB F08.CVIDE
    COLOR 15: LOCATE 9, 5:  PRINT "  Possibilit‚s Commandes"
    COLOR 11: LOCATE 10, 4: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹"
    COLOR 10: LOCATE 11, 6: PRINT "1 pour 1 D‚placement"
    LOCATE 12, 6: PRINT "2      2 D‚placements"
    LOCATE 13, 6: PRINT "      .../...    "
    LOCATE 14, 6: PRINT "8      8"
    LOCATE 15, 6: PRINT "9      9"
    COLOR 11: LOCATE 16, 6: PRINT "A pour sens trigo"
              LOCATE 17, 6: PRINT "Z pour Arret Rotation"
              LOCATE 18, 6: PRINT "E pour Sens d'une Montre"
    COLOR 14: LOCATE 19, 6: PRINT "+ / - Modif. Vitesse"
    COLOR 12: LOCATE 21, 6: PRINT "    Esc pour SORTIR"
 
' *** Dur‚e cycle programme
    Titre = "Cycle :                   "
    L% = 24: GOSUB F06G
    Ydcp% = 362 ' Ligne sup‚rieure affichage dur‚e cycle programme
    Xdcp% = 118 ' Colonne gauche
    D.d.C.Pr = "*******"
 
' *** Valeur de la "temporisation"
    Titre = " Valeur de Tempo " + SPACE$(24)
    L% = 26: C% = 34: Cct% = 11: GOSUB F06.TITRE
    Yvt% = 411 ' Ligne sup‚rieure affichage de la temporisation
    Xvt% = 408 ' Colonne gauche affichage
    Temporisation.Pr = SPACE$(12)
 
' *** Dur‚e de la pause
    Titre = "Pause :                   "
    L% = 27: GOSUB F06G
    Ydp% = 413' Ligne sup‚rieure affichage dur‚e de la pause
    Xdp% = 118 ' Colonne gauche
    D.d.R.Pr = "*******"
 
' *** Aire de Tournage (?)
    Lchg% = 8: Cchg% = 34: Lcbd% = 25: Ccbd% = 76: GOSUB F08.CVIDE
    LINE (272, 121)-(602, 389), 1, BF
   
' *** Peinture entre cadres
    Dalle = CHR$(2) + CHR$(64) + CHR$(128)
    PAINT (400, 48), Dalle, 11: GOSUB F00.CADRE
    LOCATE 30, 1: PRINT SPACE$(80);
 
' *** Valeurs initiales
    Xc% = 436: Yc% = 254: Rayon% = 105: R.Balle% = 20: C.Balle% = 14
    PI! = 3.14159: Angle.Grade& = 100: Nbre.Depl% = 1: Sens% = 1
    Delta.Angle% = 1
    CIRCLE (Xc%, Yc%), 4, 11: PAINT (Xc%, Yc%), 11, 11
 
' *** Test de rapidit‚ du PC
    Debut# = TIMER
    DO
        Temporisation# = Temporisation# + 1
    LOOP UNTIL TIMER >= Debut# + .5' Temporisation d'une 1/2 seconde
    GOSUB F09.AFFICHAGE.Temporisation
   
    Debut.du.Tour.Precedent! = TIMER
' ***** D‚but de Bouclette g‚n‚rale *******************************************
    DO
    Debut.du.Cycle! = TIMER
' *** Ralentisseur
    Debut.du.Ralentisseur! = TIMER
    T& = 0
    FOR I# = 1 TO Temporisation#
        IF TIMER > 0 THEN T& = T& + 1
        ' *** Sans le IF ci-dessus, les r‚sultats sont ENTIEREMENT diff‚rents
    NEXT I#
    Duree.du.Ralentisseur! = TIMER - Debut.du.Ralentisseur!
    GOSUB F12.AFFICHAGE.DUREE.DU.RALENTISSEUR
 
' *** Les ordres
    INK = INKEY$: IF INK = "" GOTO PAS.D.INK
        SELECT CASE UCASE$(INK)
            CASE "1" TO "9": Nbre.Depl% = VAL(INK)
            CASE "A": Sens% = 1
            CASE "Z": Sens% = 0
            CASE "E": Sens% = -1
            CASE "+": Temporisation# = Temporisation# * .95
                      GOSUB F09.AFFICHAGE.Temporisation
                      GOSUB F12.AFFICHAGE.DUREE.DU.RALENTISSEUR
            CASE "-": Temporisation# = Temporisation# * 1.05
                      GOSUB F09.AFFICHAGE.Temporisation
                      GOSUB F12.AFFICHAGE.DUREE.DU.RALENTISSEUR
        END SELECT
    
PAS.D.INK:
    FOR Deplacement% = 1 TO Nbre.Depl%
        Angle.Grade& = Angle.Grade& + Sens%
        ' *** La balle est-elle au NORD ???
        ' Si l'angle est positif, il est ‚gal … 100 + n x 400
        ' Si l'angle est n‚gatif, il est ‚gal … 100 - n x 400
        A.G& = ABS(Angle.Grade& - 100)
        IF A.G& MOD 400 = 0 THEN
            BEEP: GOSUB F10.AFFICHAGE.TOUR
            Debut.du.Tour.Precedent! = TIMER
        END IF
        Angle.Radian# = PI! / 200 * Angle.Grade&
        Xb! = Xc% + Rayon% * COS(Angle.Radian#)
        Yb! = Yc% - Rayon% * SIN(Angle.Radian#)
            IF Debut = "" THEN ' *** La balle n'est dessin‚e qu'une fois
                CIRCLE (Xb!, Yb!), R.Balle%, 12
                PAINT (Xb!, Yb!), 12, 12
                CIRCLE (Xb!, Yb!), R.Balle% - 5, C.Balle%
                PAINT (Xb!, Yb!), C.Balle%, C.Balle%
                CIRCLE (Xb!, Yb!), 7, 0: PAINT (Xb!, Yb!), 0, 0
                Xchg% = Xb! - R.Balle% - 6: Ychg% = Yb! - R.Balle% - 6
                Xcbd% = Xb! + R.Balle% + 6: Ycbd% = Yb! + R.Balle% + 6
                GET (Xchg%, Ychg%)-(Xcbd%, Ycbd%), T.Balle&
                Debut = "AZER"
            ELSE
                PUT (Xb! - R.Balle% - 8, Yb! - R.Balle% - 8), T.Balle&, PSET
            END IF
    NEXT Deplacement%
   
    Duree.du.Cycle! = TIMER - Debut.du.Cycle!
    GOSUB F11.AFFICHAGE.DUREE.DU.CYCLE
    D.d.C.Pr = D.d.C
 
    LOOP UNTIL INKEY$ = CHR$(27)
'****** Fin du Cycle d'affichage de la balle tournante **********************
 
E98.CEFINI: COLOR 15: END
 
E99.ERREUR: LOCATE 30, 10: COLOR 12
    PRINT USING "  ERREUR : ### Voir Programmeur ?????"; ERR;
    GOSUB F01.SIRENE: SLEEP: GOTO E98.CEFINI
   
F00.CADRE: FOR I% = 1 TO 16: LINE (I%, I%)-(I%, 232), Ccf%, , 32752: NEXT I%
    Y% = 234
    FOR X% = 1 TO 16: Y% = Y% - 1: LINE (X%, Y%)-(X%, 464), Ccf%, , 4095: NEXT X%
    FOR I% = 1 TO 16: LINE (I%, I%)-(320, I%), Ccf%, , 32752: NEXT I%
    X% = 322
    FOR Y% = 1 TO 16: X% = X% - 1: LINE (X%, Y%)-(640, Y%), Ccf%, , 4095: NEXT Y%
    Y% = 465
    FOR X% = 1 TO 16: Y% = Y% - 1: LINE (X%, Y%)-(320, Y%), Ccf%, , 32752: NEXT X%
    X% = 322: Y% = 465
    FOR I% = 1 TO 16: X% = X% - 1: Y% = Y% - 1
        LINE (X%, Y%)-(640, Y%), Ccf%, , 4095
    NEXT I%
    X% = 641
    FOR Y% = 1 TO 16: X% = X% - 1: LINE (X%, Y%)-(X%, 232), Ccf%, , 32752: NEXT Y%
    X% = 641: Y% = 234
    FOR I% = 1 TO 16: X% = X% - 1: Y% = Y% - 1
        LINE (X%, Y%)-(X%, 464), Ccf%, , 4095
    NEXT I%
    Ccf% = 11
    LINE (1, 1)-(24, 24), Ccf%, B: LINE (1, 1)-(24, 24), Ccf%
    LINE (1, 24)-(24, 1), Ccf%: PAINT (6, 12), Ccf%, Ccf%
    PAINT (12, 6), Ccf%, Ccf%: PAINT (18, 12), Ccf% - 8, Ccf%
    PAINT (12, 18), Ccf% - 8, Ccf%: 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 (616, 1), G&, PSET
    PUT (617, 220), G&, PSET: PUT (617, 441), G&, PSET
    RETURN
 
' *** SIRENE ET AFFICHAGE MESSAGE en Ligne 30
F01.SIRENE: FOR Z% = 500 TO 100 STEP -5: SOUND Z%, Z% / 5000: NEXT Z%: RETURN
F01.ERR: BEEP: LOCATE 30, 10: COLOR 14: PRINT Faux; : GOSUB F02.ATTENTE
    IF K = CHR$(27) THEN CLS : COLOR 15: END
    LOCATE 30, 1: COLOR Cfd%: PRINT SPACE$(80); : RETURN
F02.ATTENTE: K = INKEY$: IF K = "" GOTO F02.ATTENTE
    RETURN
 
' *** TITRE ENTOURE d'un CADRE
F06G: L% = L% - 1: C% = 4: GOTO F06.TITRE
F06C: L% = L% - 1: C% = 39 - LEN(Titre) / 2: GOTO F06.TITRE
F06D: L% = L% - 1: C% = 76 - LEN(Titre)
F06.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
F06.REMPLI: Xg% = C% * 8 + 1: 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
 
' *** AFFICHAGE sur ECRAN d'un CADRE VIDE
F08.CVIDE: 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
 
F09.AFFICHAGE.Temporisation:
    Temporisation = LTRIM$(STR$(INT(Temporisation#)))
    IF LEN(Temporisation) < 9 THEN
        Temporisation = STRING$(9 - LEN(Temporisation), "0") + Temporisation
    END IF
    Temporisation = MID$(Temporisation, 1, 3) + "." + MID$(Temporisation, 4, 3) + "." + RIGHT$(Temporisation, 3)
    XX% = Xvt%: YY% = Yvt%: Daf% = 2: Faf% = 17
    AUXI = Temporisation: AUXI.PR = Temporisation.Pr
    GOSUB F50.AFFICHAGE.GENERAL
    Temporisation.Pr = Temporisation
    RETURN
 
F10.AFFICHAGE.TOUR: Duree.du.Tour! = TIMER - Debut.du.Tour.Precedent!
    D.d.T! = INT(Duree.du.Tour! * 1000)
    D.d.T = LTRIM$(STR$(D.d.T!)): Lg% = LEN(D.d.T)
    IF Lg% < 6 THEN D.d.T = STRING$(6 - Lg%, "0") + D.d.T
    D.d.T = LEFT$(D.d.T, 3) + "." + RIGHT$(D.d.T, 3)
    XX% = Xddt%: YY% = Yddt%: Daf% = 1: Faf% = 7
    AUXI = D.d.T: AUXI.PR = D.d.T.PR
    GOSUB F50.AFFICHAGE.GENERAL: D.d.T.PR = D.d.T
    RETURN
 
F11.AFFICHAGE.DUREE.DU.CYCLE:
    D.d.C! = INT(Duree.du.Cycle! * 10000)
    D.d.C = LTRIM$(STR$(D.d.C!)): Lg% = LEN(D.d.C)
    IF Lg% < 6 THEN D.d.C = STRING$((6 - Lg%), "0") + D.d.C
    D.d.C = LEFT$(D.d.C, 2) + "." + RIGHT$(D.d.C, 4)
    XX% = Xdcp% - 17: YY% = Ydcp%: Daf% = 1: Faf% = 7
    AUXI = D.d.C: AUXI.PR = D.d.C.Pr
    GOSUB F50.AFFICHAGE.GENERAL: D.d.C.Pr = D.d.C
    RETURN
 
F12.AFFICHAGE.DUREE.DU.RALENTISSEUR:
    D.d.R! = INT(Duree.du.Ralentisseur! * 10000)
    D.d.R = LTRIM$(STR$(D.d.R!)): Lg% = LEN(D.d.R)
    IF Lg% < 6 THEN D.d.R = STRING$((6 - Lg%), "0") + D.d.R
    D.d.R = LEFT$(D.d.R, 2) + "." + RIGHT$(D.d.R, 4)
    XX% = Xdp% - 17: YY% = Ydp%: Daf% = 1: Faf% = 7
    AUXI = D.d.R: AUXI.PR = D.d.R.Pr
    GOSUB F50.AFFICHAGE.GENERAL: D.d.R.Pr = D.d.R
    RETURN
 
F50.AFFICHAGE.GENERAL:
    FOR P% = Daf% TO Faf%
        XX% = XX% + 17
        IF MID$(AUXI, P%, 1) = MID$(AUXI.PR, P%, 1) GOTO F50A
        SELECT CASE MID$(AUXI, P%, 1)
            CASE "0", " ": PUT (XX%, YY%), C0&, PSET
            CASE "1": PUT (XX%, YY%), C1&, PSET
            CASE "2": PUT (XX%, YY%), C2&, PSET
            CASE "3": PUT (XX%, YY%), C3&, PSET
            CASE "4": PUT (XX%, YY%), C4&, PSET
            CASE "5": PUT (XX%, YY%), C5&, PSET
            CASE "6": PUT (XX%, YY%), C6&, PSET
            CASE "7": PUT (XX%, YY%), C7&, PSET
            CASE "8": PUT (XX%, YY%), C8&, PSET
            CASE "9": PUT (XX%, YY%), C9&, PSET
            CASE ".": PUT (XX%, YY%), CP&, PSET
            CASE "-", "/": PUT (XX%, YY%), CM&, PSET
        END SELECT
F50A: NEXT P%
    RETURN