mainTitle = "Exemple de gestion de feux tricolores en FORTH"; 
$this->asideSection = "Ceci est un exemple de getion des ports sur Arduino en FORTH " 
. "dans lequel on gère trois LEDs pour simuler un feu tricolore"; 
?> 
\ ****************************************************************************** 
\ Exemple de gestion de feux tricolores en FORTH 
\ 
\ Forth version: Flash Forth (http://flashforth.com/)  
\ author: M PETREMANN 
\ Creation:     25 mai 2019 
\ Modification: 26 mai 2019 
\ ****************************************************************************** 
 
decimal 
flash    fl+         \ selection mémoire FLASH 
-readwrite           \ supprime les précédentes définitions crées après -readwrite 
marker -readwrite    \ définit le marqueur -readwrite 
decimal 
 
: depth ( --- n ) \ depth of stack 
  sp@ s0 @ - 2/ abs ; 
 
: needed ( .., n --- ) 
  depth 1- swap <  
  if    ." pas assez d'éléments sur la pile" abort 
  then ; 
 
\ PORTB 
37 constant PORTB	\ Port B Data Register 
36 constant DDRB	\ Port B Data Direction Register 
35 constant PINB	\ Port B Input Pins 
 
\ mot permettant de créer les mots PINxx 
: defPin: ( PORTx mask ---  |  --- mask port) 
    2 needed 
    create 
        c, c,           \ compile PORT et masque du pin à définir 
    does> 
        dup c@          \ empile masque du pin 
        swap 1+ c@      \ empile PORT du pin 
    ; 
\ exemple  
\ PORTB $80 defPin: pin13 
 
\ constantes servant de flag dans pinMode 
$ff constant OUTPUT 
$00 constant INPUT 
 
\ alias en FORTH de la fonction pinMode() en langage C 
: pinMode (  state ---) 
    3 needed 
    0= if 
        1- dup c@       \ récupère valeur DDR 
        rot $ff xor     \ XOR logique avec $ff 
        and swap c!     \ ET logique avec résultat, remet valeur dans DDR 
    else 
        1- dup c@       \ récupère valeur DDR 
        rot or          \ OU logique avec mask 
        swap c!         \ remet valeur dans DDR 
    then ; 
\ Exemple:  
\ pin13 OUTPUT pinMode 
\ pin13 INPUT  pinMode 
 
: digitalRead (  --- fl) 
    2 needed 
    1- 1- c@ and        \ récupère valeur registre PIN, fait un AND logique 
    if      true        \ si valeur pas nulle, empile TRUE     
    else    false       \ si valeur nulle, empile FALSE 
    then ; 
 
\ Exemple: 
\ pin13 digitalRead 
 
: pinON (  ---) 
    dup c@          \ récupère valeur registre PORT 
    rot or          \ fait un OR logique 
    swap c!  ;      \ met résultat dans registre PORT 
: pinOFF (  ---) 
    dup c@          \ récupère valeur registre PORT 
    rot $ff xor and \ fait un XOR sur masque suivi de AND  
    swap c!  ;      \ met résultat dans registre 
 
\ alias en FORTH de la fonction digitalWrite() en langage C 
: digitalWrite (  fl ---) 
    3 needed 
    0= if 
        pinOFF 
    else 
        pinON 
    then ; 
\ Exemple: 
\ pin13 HIGH digitalWrite 
 
\ définition pinXX 
PORTB $80 defPin: pin13 
PORTB $40 defPin: pin12 
PORTB $20 defPin: pin11 
 
false  constant LOW 
true   constant HIGH 
 
: pin13-on ( ---) 
    pin13 HIGH digitalWrite ; 
: pin13-off ( ---) 
    pin13 LOW digitalWrite ; 
: pin12-on ( ---) 
    pin12 HIGH digitalWrite ; 
: pin12-off ( ---) 
    pin12 LOW digitalWrite ; 
: pin11-on ( ---) 
    pin11 HIGH digitalWrite ; 
: pin11-off ( ---) 
    pin11 LOW digitalWrite ; 
 
: init-feux ( ---) 
    pin11 OUTPUT pinMode 
    pin12 OUTPUT pinMode 
    pin13 OUTPUT pinMode ; 
 
: feu-vert ( n ---) 
    1 needed 
    pin11-on 
    ms              \ n valeur délai d'allumage en millisecondes 
    pin11-off ; 
: feu-orange ( n ---) 
    1 needed 
    pin12-on 
    ms              \ n valeur délai d'allumage en millisecondes 
    pin12-off ; 
: feu-rouge ( n ---) 
    1 needed 
    pin13-on 
    ms              \ n valeur délai d'allumage en millisecondes 
    pin13-off ; 
 
: feux-tricolores ( ---) 
    \ valeurs 3000 500 et 3000 corespondent au délai en millisecondes 
    \ d'activation de chaque feu. 
    3000 feu-vert 
    500  feu-orange 
    3000 feu-rouge ; 
\ feux-tricolores exécute un seul cycle de feux 
 
: feux ( ---) 
    init-feux 
    begin 
        feux-tricolores 
    key? until ; 
 
\ variante feux allemands 
: feu-mixte ( n ---) 
    1 needed 
    pin12-on        \ allume feu rouge et orange en même temps 
    pin13-on 
    ms              \ n valeur délai d'allumage en millisecondes 
    pin12-off 
    pin13-off ; 
: feux-allemands ( ---) 
    init-feux 
    begin 
        3000 feu-vert 
        500  feu-orange 
        3000 feu-rouge  
        500 feu-mixte 
    key? until ;