( Pendulette digitale.
  Version 1.00 du 23 Septembre 2012.
  Ecrit par jpb.forth .
)

TELECHARGEMENT

( Registres de la fenetre "AFFICHEURS":
  -------------------------------------
)

DECIMAL

0 VARIABLE ETAT_HEURE

"  0000008" STRING S_HEURE
"  0000008" STRING S_REGLAGE_HEURE

: INCREMENTE_SECONDE
 S_HEURE DUP 7+ C@ 1+ DUP 57 >
 IF
  DROP 48 OVER 7+ C! DUP 6+ C@ 127 AND 1+ DUP 57 >
  IF
   DROP 48 128+ OVER 6+ C! DUP 5+ C@ 1+ DUP 53 >
   IF
    DROP 48 OVER 5+ C! DUP 4+ C@ 127 AND 1+ DUP 57 >
    IF
     DROP 48 128+ OVER 4+ C! DUP 3+ C@ 1+ DUP 53 >
     IF
      DROP 48 OVER 3+ C! DUP 2+ C@ 127 AND 1+ OVER 1+ C@ 49 >
      IF
       DUP 51 >
      ELSE
       DUP 57 >
      THEN
      IF
       DROP 48 128+ OVER 2+ C! DUP 1+ C@ DUP 32 = 16 AND + 1+ DUP 50 >
       IF
        DROP 32
       THEN
       OVER 1+ C!
      ELSE
       128+ OVER 2+ C!
      THEN
     ELSE
      OVER 3+ C!
     THEN
    ELSE
     128+ OVER 4+ C!
    THEN
   ELSE
    OVER 5+ C!
   THEN
  ELSE
   128+ OVER 6+ C!
  THEN
 ELSE
  OVER 7+ C!
 THEN
 >R 56 R> 8+ C!
;

TACHE: T_HEURE
 INCREMENTE_SECONDE S_HEURE 1+ DUP 6+ C@ 48- DUP 5 MOD 0=
 IF
  SWAP >R 5 <
  IF
   R@ C@ 48- 0 MAX 10 * R@ 1+ C@ 127 AND 48- + 12 MOD 10 *
   R@ 2+ C@ 48- 10 * R@ 3+ C@ 127 AND 48- + DUP >R 6 /MOD SWAP DROP + MOTEUR R> 2*
   R@ 4+ C@ 48- 10 * R@ 5+ C@ 127 AND 48- + DUP >R 30 /MOD SWAP DROP +
   MOTEUR_G R> 2*
  ELSE
   R@ 4+ C@ 48- 10 * R@ 5+ C@ 127 AND 48- + 2* 1+
  THEN
  MOTEUR_I R>
 ELSE
  DROP
 THEN
 AFFICHEUR
;

: MISE_A_L'HEURE
 ETAT_HEURE @ 0=
 IF
  128 DUP S_HEURE 2+ DUP >R +C! DUP R@ 2+ +C! R> 4+ +C!
  -1 ETAT_HEURE ! 40000 T_HEURE DUP >R T_AJOUTE 100 R> T_PERIODE
 THEN
 ." Mise a l'heure de la pendulette digitale HH MM SS : "
 S_REGLAGE_HEURE 1
 BEGIN
  KEY OVER CASE
   1 OF
    DUP 47 > OVER 51 < AND
    IF
     DUP EMIT 3 PICK 3 PICK + C! 1+
    ELSE
     DROP BELL
    THEN
   ENDOF
   2 OF
    DUP 47 >
    IF
     3 PICK C@ 50 <
     IF
      DUP 58 <
     ELSE
      DUP 52 <
     THEN
     IF
      DUP EMIT 104 EMIT 128+ 3 PICK 3 PICK + C! 1+
     ELSE
      DROP BELL
     THEN
    ELSE
     DROP BELL
    THEN
   ENDOF
   3 OF
    DUP 47 > OVER 54 < AND
    IF
     DUP EMIT 3 PICK 3 PICK + C! 1+
    ELSE
     DROP BELL
    THEN
   ENDOF
   4 OF
    DUP 47 > OVER 58 < AND
    IF
     DUP EMIT 109 EMIT 128+ 3 PICK 3 PICK + C! 1+
    ELSE
     DROP BELL
    THEN
   ENDOF
   5 OF
    DUP 47 > OVER 54 < AND
    IF
     DUP EMIT 3 PICK 3 PICK + C! 1+
    ELSE
     DROP BELL
    THEN
   ENDOF
   6 OF
    DUP 47 > OVER 58 < AND
    IF
     DUP EMIT 115 EMIT 128+ 3 PICK 3 PICK + C! 1+
     48 3 PICK 3 PICK + C! 1+ 56 3 PICK 3 PICK + C! 1+
    ELSE
     DROP BELL
    THEN
   ENDOF
   DROP
  ENDCASE
  DUP 8 >
 UNTIL
 >R DUP 1+ DUP >R C@ DUP 48 = 16 AND - R> C! S_HEURE R> CMOVE
 ."

Pour refaire une mise a l'heure, utiliser l'instruction MISE_A_L'HEURE .
"
;

MISE_A_L'HEURE

( FIN
)