( Experimentation VT100.
  Version 0.10 du 9 Decembre 2012.
  Ecrit par jpb.forth .
)

TELECHARGEMENT

( Ce programme experimental permet de profiter des attributs video
  du terminal VT100 pour en faire une demonstration visuelle
  des possibilites du noyau temps reel.
)

DECIMAL

0 VARIABLE VT100_NB_TACHES
0 VARIABLE VT100_ETAT_TACHES

: VT100_SAUVE_ATTRIBUTS
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 55 EMIT
 R> !
;

: VT100_RESTITUE_ATTRIBUTS
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 56 EMIT
 R> !
;

: VT100_CARACTERE_NORMAL
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 48 EMIT 109 EMIT
 R> !
;

: VT100_CARACTERE_GRAS
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 49 EMIT 109 EMIT
 R> !
;

: VT100_CARACTERE_SOULIGNE
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 52 EMIT 109 EMIT
 R> !
;

: VT100_CARACTERE_CLIGNOTANT
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 53 EMIT 109 EMIT
 R> !
;

: VT100_CARACTERE_INVERSE
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 55 EMIT 109 EMIT
 R> !
;

: VT100_GRAPHIQUE
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 40 EMIT 48 EMIT
 R> !
;

: VT100_ASCII
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 40 EMIT 66 EMIT
 R> !
;

: VT100_EFFACE_LIGNE
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 48 EMIT 75 EMIT
 R> !
;

: VT100_EFFACE_ECRAN
 PRIORITE DUP >R @ 32768 R@ !
 27 EMIT 91 EMIT 50 EMIT 74 EMIT
 R> !
;

: VT100_CURSEUR_POSITION ( x,y --> - )
 PRIORITE DUP >R @ 32768 R@ ! >R
 27 EMIT 91 EMIT 1+ 10 /MOD 10 MOD 48+ EMIT 48+ EMIT
 59 EMIT 1+ 10 /MOD 10 MOD 48+ EMIT 48+ EMIT 72 EMIT
 R> R> !
;

0 VARIABLE V_JPBFORTH

TACHE: T_JPBFORTH
 TELEC @ 0=
 IF
  VT100_ETAT_TACHES @
  IF
   111 T_JPBFORTH T_ACTIVE
   V_JPBFORTH DUP >R @ DUP 1+ 21 MOD R> !
   CASE
    0 OF
     VT100_SAUVE_ATTRIBUTS 
     0 0 VT100_CURSEUR_POSITION VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS
     5 SPACES
     VT100_RESTITUE_ATTRIBUTS
    ENDOF
    3 OF
     VT100_SAUVE_ATTRIBUTS
     0 0 VT100_CURSEUR_POSITION VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS
     2 SPACES 74 EMIT  2 SPACES
     VT100_RESTITUE_ATTRIBUTS
    ENDOF
    6 OF
     VT100_SAUVE_ATTRIBUTS
     0 0 VT100_CURSEUR_POSITION VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS
     32 EMIT 74 EMIT 32 EMIT 80 EMIT 32 EMIT
     VT100_RESTITUE_ATTRIBUTS
    ENDOF
    9 OF
     VT100_SAUVE_ATTRIBUTS
     0 0 VT100_CURSEUR_POSITION VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS
     74 EMIT 32 EMIT 80 EMIT 32 EMIT 66 EMIT
     VT100_RESTITUE_ATTRIBUTS
    ENDOF
    12 OF
     VT100_SAUVE_ATTRIBUTS
     0 0 VT100_CURSEUR_POSITION VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS
     70 EMIT 79 EMIT 82 EMIT 84 EMIT 72 EMIT
     VT100_RESTITUE_ATTRIBUTS
    ENDOF
   ENDCASE
  ELSE
   VT100_SAUVE_ATTRIBUTS
   0 0 VT100_CURSEUR_POSITION
   5 SPACES
   VT100_RESTITUE_ATTRIBUTS
   T_JPBFORTH T_RETIRE 1 VT100_NB_TACHES -!
  THEN
 ELSE
  999 T_JPBFORTH T_ACTIVE
 THEN
;

0 VARIABLE V_OCCUPATION
HERE 1 10 2/ + ALLOT CONSTANT F_MESURE
0 VARIABLE V_MESURE

TACHE: T_PERF
 TELEC @ 0=
 IF
  VT100_SAUVE_ATTRIBUTS 34 0 VT100_CURSEUR_POSITION
  VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS ."  MicroFORTH "
  VT100_CARACTERE_NORMAL 65 0 VT100_CURSEUR_POSITION VT100_ETAT_TACHES @
  IF
   VT100_CARACTERE_INVERSE VT100_CARACTERE_GRAS VT100_GRAPHIQUE
   F_MESURE DUP 2+ SWAP @ 10 0 DO
    1+ 10 MOD OVER OVER + C@ 20 /
    CASE
     0 OF
      95
     ENDOF
     1 OF
      115
     ENDOF
     2 OF
      114
     ENDOF
     3 OF
      113
     ENDOF
     4 OF
      112
     ENDOF
     111
    ENDCASE
    EMIT
   LOOP
   + C@ 10 /MOD 10 /MOD VT100_ASCII ?DUP
   IF
    48+ EMIT 48+
   ELSE
    32 EMIT ?DUP
    IF
     48+
    ELSE
     32
    THEN
   THEN
   EMIT 48+ EMIT 37 EMIT
  ELSE
   14 0 DO
    32 EMIT
   LOOP
   1 VT100_NB_TACHES -!
  THEN
  VT100_RESTITUE_ATTRIBUTS 
 THEN
 T_PERF T_RETIRE
;

TACHE: T_OCCUPATION
 1 V_OCCUPATION +! 0 T_OCCUPATION T_ACTIVE
;

TACHE: T_MESURE
 VT100_ETAT_TACHES @
 IF
  V_MESURE DUP >R @ DUP NOT R> !
  IF
   1000 TEMPS @ OVER U/MOD DROP - 0 MAX
  ELSE
   100 V_OCCUPATION DUP >R @ 10 / 100 MIN - 0 R> !
   DUP F_MESURE DUP >R @ 1+ 10 MOD DUP R@ ! 2+ R> + C!
   32768 T_PERF T_AJOUTE 1 T_PERF T_ACTIVE
   99 MIN 10 *
  THEN
  T_MESURE T_ACTIVE
 ELSE
  T_MESURE T_RETIRE T_OCCUPATION T_RETIRE
  32768 T_PERF T_AJOUTE 1 T_PERF T_ACTIVE
 THEN
;

: VT100_INSTALLE_TACHES
 -1 VT100_ETAT_TACHES ! 1 VT100_NB_TACHES !
 32768 T_JPBFORTH T_AJOUTE 10 T_JPBFORTH T_ACTIVE
 1 VT100_NB_TACHES +!
 0 V_OCCUPATION ! 0 V_MESURE ! 1 T_OCCUPATION T_AJOUTE
 65535 T_MESURE T_AJOUTE 10 T_OCCUPATION T_ACTIVE 1000 T_MESURE T_ACTIVE
;

: VT100_RETIRE_TACHES
 0 VT100_ETAT_TACHES !
;

: CLS
 0 0 VT100_CURSEUR_POSITION VT100_EFFACE_ECRAN
;

: INIT_VT100
 TELEC @
 IF
  4000 TEMPO KEY DROP CR
 THEN
 CLS VT100_INSTALLE_TACHES CR
;

: RETIRE_VT100
 VT100_RETIRE_TACHES
;

INIT_VT100