Guide Tutoriel de BBC BASIC for Windows, App. F

Appendice F — Listing : Générateur de caractères

     REM ****************************************
     REM * Générateur de caractères utilisateur *
     REM * Version 1.0                 2/1/2006 *
     REM * Peter Nairn                          *
     REM ****************************************

     REM Déclarer les tableaux et la structure
     DIM Grille%(8,8)
     DIM TtalLigne%(8)
     DIM Curs{Ligne%,Col%,DernLigne%,DernCol%}

     PROC_Init
     PROC_DessEcranPrinc
     PROC_DessCarac
     PROC_DessCurs

     REPEAT
       Action%=FN_InterceptAction
       PROC_TraiterAction(Action%)
     UNTIL Exit

     PROC_Fermeture

     END

     REM ***************************************************
     REM PROC_Init - initialisation d'origine au lancement
     DEF PROC_Init

     REM Mettre en mode graphique
     MODE 21

     REM Définir les caractères 240, 241 et 242
     VDU 23,240,0,0,0,0,0,0,0,0
     VDU 23,241,255,129,129,129,129,129,129,255
     VDU 23,242,255,255,255,255,255,255,255,255

     REM Définir la position du curseur
     Curs.Ligne%=1
     Curs.DernLigne%=1
     Curs.Col%=1
     Curs.DernCol%=1

     REM Initialiser le drapeau de Sortie à 0
     Exit=FALSE

     REM Éteindre le curseur de texte
     VDU 23,1,0;0;0;0;

     ENDPROC

     REM ***************************************************
     REM PROC_DessEcranPrinc - affiche le texte statique,
     REM                       le titre, l'aide, etc.
     DEF PROC_DessEcranPrinc

     REM Fixer la couleur de fond
     COLOUR 128+7
     CLS
     COLOUR 0

     REM Afficher le titre
     PRINT TAB(12,0);"Générateur de Caractères"
     PRINT TAB(12,1);STRING$(24,"=")

     REM Afficher les instructions d'aide
     PRINT TAB(1,3);"Instructions :"
     PRINT TAB(1,4);"Flèches = déplacer curseur."
     PRINT TAB(1,5);"Espace = bascule de cellule."
     PRINT TAB(1,6);"Taper X ou ESC pour sortir."

     ENDPROC

     REM ***************************************************
     REM PROC_DessCarac - appelée quand le caractère change
     REM                  afin de le réafficher
     DEF PROC_DessCarac
     LOCAL ValCol%,Ligne%,Col%

     REM Tracer la Grille & calculer chaque total de ligne
     FOR Ligne%=1 TO 8
       ValCol%=128
       TtalLigne%(Ligne%)=0
       FOR Col%=1 TO 8
         IF Grille%(Col%,Ligne%)=0 THEN
           PRINT TAB(18+Col%,10+Ligne%);CHR$(241)
         ELSE
           PRINT TAB(18+Col%,10+Ligne%);CHR$(242)
           TtalLigne%(Ligne%)=TtalLigne%(Ligne%)+ValCol%
         ENDIF
         ValCol%=ValCol%/2
       NEXT Col%

       PRINT TAB(28,10+Ligne%);"    "
       PRINT TAB(28,10+Ligne%);TtalLigne%(Ligne%)
     NEXT Ligne%

     REM Dessiner le caractère réel
     VDU 23,240,TtalLigne%(1),TtalLigne%(2),TtalLigne%(3), \
     \         TtalLigne%(4),TtalLigne%(5),TtalLigne%(6), \
     \         TtalLigne%(7),TtalLigne%(8)
     FOR Col%=1 TO 8
       PRINT TAB(18+Col%,20);CHR$(240)
     NEXT Col%

     REM Afficher les codes VDU
     PRINT TAB(7,22);"Code BASIC pour faire ce caractère : "
     PRINT TAB(1,24);STRING$(50," ")
     PRINT TAB(4,24);"VDU 23,240";
     FOR Ligne%=1 TO 8
       PRINT ",";STR$(TtalLigne%(Ligne%));
     NEXT Ligne%

     ENDPROC

     REM ***************************************************
     REM PROC_DessCurs - effacer le curseur de l'ancienne
     REM                 position & redessiner à la nouvelle
     DEF PROC_DessCurs

     REM Mettre à couleur normale et effacer ancien curseur
     COLOUR 0
     PRINT TAB(18+Curs.DernCol%,10+Curs.DernLigne%);
     IF Grille%(Curs.DernCol%,Curs.DernLigne%)=0 THEN
       PRINT CHR$(241)
     ELSE
       PRINT CHR$(242)
     ENDIF
     REM Mettre en surbrillance et dessiner le curseur
     COLOUR 1
     PRINT TAB(18+Curs.Col%,10+Curs.Ligne%);
     IF Grille%(Curs.Col%,Curs.Ligne%)=0 THEN
       PRINT CHR$(241)
     ELSE
       PRINT CHR$(242)
     ENDIF
     REM Remettre la couleur normale
     COLOUR 0

     ENDPROC

     REM ***************************************************
     REM FN_InterceptAction - renvoie 1 code d'action valide
     REM                      quand choisi par l'utilisateur
     DEF FN_InterceptAction
     LOCAL Touche%,Code%

     REPEAT
       REM Attendre qu'une touche soit pressée
       Touche%=GET
       REM Traduire la touche en code d'action
       CASE Touche% OF
         WHEN 139: Code%=1   :REM Haut
         WHEN 137: Code%=2   :REM Droite
         WHEN 138: Code%=3   :REM Bas
         WHEN 136: Code%=4   :REM Gauche
         WHEN 32: Code%=5    :REM Bascule - espace
         WHEN 88: Code%=999  :REM Sortie
         WHEN 120: Code%=999
         OTHERWISE Code%=0
       ENDCASE
     UNTIL Code%<>0

     =Code%

     REM ***************************************************
     REM PROC_TraiterAction - actionne un code valide
     DEF PROC_TraiterAction(Code%)

     CASE Code% OF
       WHEN 1: PROC_DeplaCurs(1)
       WHEN 2: PROC_DeplaCurs(2)
       WHEN 3: PROC_DeplaCurs(3)
       WHEN 4: PROC_DeplaCurs(4)
       WHEN 5:
         IF Grille%(Curs.Col%,Curs.Ligne%)=1 THEN
           Grille%(Curs.Col%,Curs.Ligne%)=0
         ELSE
           Grille%(Curs.Col%,Curs.Ligne%)=1
         ENDIF
         PROC_DessCarac
       WHEN 999:
         REM Mettre le drapeau de Sortie à 1
         Exit=TRUE
     ENDCASE

     PROC_DessCurs

     ENDPROC

     REM ***************************************************
     REM PROC_DeplaCurs - déplacer le curseur
     REM                  dans la direction donnée : 
     REM                  1-Haut, 2-Droite, 3-Bas, 4-Gauche
     DEF PROC_DeplaCurs(Dirn%)

     REM Conserve position actuelle dans Position ancienne
     Curs.DernLigne%=Curs.Ligne%
     Curs.DernCol%=Curs.Col%

     REM Vérifie les limites et opère le déplacement
     CASE Dirn% OF
       WHEN 1: IF Curs.Ligne%>1 Curs.Ligne% -=1
       WHEN 2: IF Curs.Col%<8 Curs.Col% +=1
       WHEN 3: IF Curs.Ligne%<8 Curs.Ligne% +=1
       WHEN 4: IF Curs.Col%>1 Curs.Col% -=1
     ENDCASE

     ENDPROC

     REM ***************************************************
     REM PROC_Fermeture - fait le ménage avant de sortir
     DEF PROC_Fermeture

     REM Réactiver le curseur de texte
     VDU 23,1,1;0;0;0;
     REM Placer le curseur au bas de l'écran
     PRINT TAB(0,26);

     ENDPROC
    

Fin de l'Appendice F