Un petit exemple de développement en langage Gforth.

Un carnet de notes qu'on peut saisir en ligne par ligne, il révèle comment procéder pour utiliser Gforth, il utilise les exemples cités précédemment, cadres, gestion des couleurs, menus, ouverture et fermeture d'un fichier chargé en mémoire de façon monobloc.
Il peut être largement amélioré mais il est fonctionnel tel quel.

0 Value id_fichier

: ouvrir-fichier ( adr u --- )
    r/w open-file throw to id_fichier
;

: fichier-en-ecriture ( adr u --- )
    w/o create-file throw to id_fichier
;

Create tampon 256 2 + allot

: lect-fichier ( adr u --- )
    begin
    tampon 256 id_fichier read-line throw
    while
        >r 2dup tampon r> compare 0=
    until
    else
    drop
    then
    2drop
;

: visu-file
    begin
    tampon 256 id_fichier read-line throw
    while
    tampon swap type cr
    repeat
;

create nomenclature 465000 allot
nomenclature 465000 32 fill

variable tmp
variable test
variable num_fiche
0 num_fiche !

variable ccol
variable clig
variable clong
variable chaut
variable corient

: cadre1 ( haut long col ligne --- )
    clig !     ccol ! clong ! chaut !
    ccol @ clig @ at-xy ." ┌" clong @ 0 do ." ─" loop ." ┐"
    chaut @ 0 do ccol @ clig @ 1+ i + at-xy ." │" clong @ spaces ." │" loop
    ccol @ clig @ chaut @ 1+ + at-xy ." └" clong @ 0 do ." ─" loop ." ┘"
;

: cadre2 ( haut long col ligne --- )
    clig !     ccol ! clong ! chaut !
    ccol @ clig @ at-xy ." ╔" clong @ 0 do ." ═" loop ." ╗"
    chaut @ 0 do ccol @ clig @ 1+ i + at-xy ." ║" clong @ spaces ." ║" loop
    ccol @ clig @ chaut @ 1+ + at-xy ." ╚" clong @ 0 do ." ═" loop ." ╝"
;

: cadre3 ( haut long col ligne --- )
    clig !     ccol ! clong ! chaut !
    ccol @ clig @ at-xy ." +" clong @ 0 do ." -" loop ." +"
    chaut @ 0 do ccol @ clig @ 1+ i + at-xy ." |" clong @ spaces ." |" loop
    ccol @ clig @ chaut @ 1+ + at-xy ." +" clong @ 0 do ." -" loop ." +"
;

: col_simple ( haut col ligne --- )
    clig ! ccol ! chaut !
    chaut @ 0 do ccol @ clig @ i + at-xy ." │" loop
;

: col_double ( haut col ligne --- )
    clig ! ccol ! chaut !
    chaut @ 0 do ccol @ clig @ i + at-xy ." ║" loop
;

: croise_simple ( orient col ligne --- )
    clig ! ccol ! corient !
    corient @ 1 = if ccol @ clig @ at-xy ." ├" then
    corient @ 2 = if ccol @ clig @ at-xy ." ┤" then
    corient @ 3 = if ccol @ clig @ at-xy ." ┬" then
;

: croise_double ( orient col ligne --- )
    clig ! ccol ! corient !
    corient @ 1 = if ccol @ clig @ at-xy ." ╠" then
    corient @ 2 = if ccol @ clig @ at-xy ." ╣" then
    corient @ 3 = if ccol @ clig @ at-xy ." ╦" then
;    

: coul_texte ( code --- )
    27 pad c!
    91 pad 1+ c!
    51 pad 2 + c!
    109 pad 4 + c!
    dup 1 = if 48 pad 3 + c! then
    dup 2 = if 49 pad 3 + c! then
    dup 3 = if 50 pad 3 + c! then
    dup 4 = if 51 pad 3 + c! then
    dup 5 = if 52 pad 3 + c! then
    dup 6 = if 53 pad 3 + c! then
    dup 7 = if 54 pad 3 + c! then
    dup 8 = if 55 pad 3 + c! then
    drop
    pad 5 type
;

: coul_fond ( code --- )
    27 pad c!
    91 pad 1+ c!
    52 pad 2 + c!
    109 pad 4 + c!
    dup 1 = if 48 pad 3 + c! then
    dup 2 = if 49 pad 3 + c! then
    dup 3 = if 50 pad 3 + c! then
    dup 4 = if 51 pad 3 + c! then
    dup 5 = if 52 pad 3 + c! then
    dup 6 = if 53 pad 3 + c! then
    dup 7 = if 54 pad 3 + c! then
    dup 8 = if 55 pad 3 + c! then
    drop
    pad 5 type
;

: coul_init ( --- )
    27 pad c!
    91 pad 1+ c!
    48 pad 2 + c!
    109 pad 3 + c!
    pad 4 type
;

: coul_contraste_inv ( ---)
    27 pad c!
    91 pad 1+ c!
    55 pad 2 + c!
    109 pad 3 + c!
    pad 4 type
;

: eff_ecran ( --- )
    0 0 at-xy
    form
    swap 0 do dup spaces loop
    drop
    0 0 at-xy
;

: eff_ligne ( n --- )
    0 swap at-xy
    form
    spaces
    drop
;

: eff_lignes ( n nb --- )
    over + swap do i eff_ligne loop
;

: aff_num_fiche
    6 coul_fond
    130 0 at-xy ." FICHE n° : "
    num_fiche @ .
    coul_init
;

: tableau_ecran
    1 158 0 3 cadre1
    30 158 0 6 cadre2
    6 coul_fond 1 coul_texte
    31 1 do 1 i 6 + at-xy i 2 .r loop
    coul_init
    30 3 7 col_simple
    aff_num_fiche
;

: aff_fiche
    tableau_ecran
    1 4 at-xy nomenclature 4650 num_fiche @ * + 150 type
    31 1 do 4 i 6 + at-xy nomenclature 4650 num_fiche @ * + i 150 * + 150 type loop
;

: saisie_index ( fiche --- )
    3 coul_texte 1 coul_fond
    1 4 at-xy 150 spaces
    1 4 at-xy nomenclature 4650 num_fiche @ * + 150 accept
    drop
    coul_init
    1 4 at-xy 150 spaces
    1 4 at-xy nomenclature 4650 num_fiche @ * + 150 type
;

: entree_ligne
    6 coul_fond 1 coul_texte
    1 2 at-xy 150 spaces
    1 2 at-xy pad 150 accept
    pad swap nomenclature 4650 num_fiche @ * + tmp @ 150 * + swap cmove
    coul_init
    1 2 at-xy 150 spaces
;

: saisie_ligne
    1 tmp !
    begin
        1 coul_texte 6 coul_fond
        4 6 tmp @ + at-xy 150 spaces 4 6 tmp @ + at-xy nomenclature 4650 num_fiche @ * + tmp @ 150 * + 150 type
        ekey
        coul_init
        4 6 tmp @ + at-xy 150 spaces 4 6 tmp @ + at-xy nomenclature 4650 num_fiche @ * + tmp @ 150 * + 150 type
        1 coul_texte 6 coul_fond
        dup k-down = if tmp @ 1+ tmp ! endif
        dup k-up = if tmp @ 1- tmp ! endif
        tmp @ 0 = if 1 tmp ! endif
        tmp @ 31 = if 30 tmp ! endif
        4 6 tmp @ + at-xy 150 spaces 4 6 tmp @ + at-xy nomenclature 4650 num_fiche @ * + tmp @ 150 * + 150 type
        dup 13 = if entree_ligne aff_fiche endif
        dup 27 = if 1 else 0 endif
        coul_init
        swap drop
    until
;
    
: sauvegarde_fichier
    s" ./Nomenclat" ouvrir-fichier
    nomenclature 465000 id_fichier write-file throw
    id_fichier close-file throw
;

: lect_fichier
    s" ./Nomenclat" ouvrir-fichier
    nomenclature 465000 id_fichier read-file throw drop
    id_fichier close-file throw
;

: fiche_precedente
    num_fiche @ 1- num_fiche !
    num_fiche @ 0 < if 0 num_fiche ! endif
    aff_fiche
;

: fiche_suivante
    num_fiche @ 1+ num_fiche !
    num_fiche @ 100 = if 99 num_fiche ! endif
    aff_fiche
;

\ Menu

1 value numopt

: menu ( opt --- )
    4 0  at-xy ."  Saisie index    "
    24 0 at-xy ."  Saisie ligne    "
    44 0 at-xy ."  Sauvegarde      "
    64 0 at-xy ."  Précédente      "
    84 0 at-xy ."  Suivante        "
    104 0 at-xy ."  Quitter         "
    dup 1 = if 4 0  at-xy ." ► Saisie index ◄ " endif
    dup 2 = if 24 0 at-xy ." ► Saisie ligne ◄ " endif
    dup 3 = if 44 0 at-xy ." ► Sauvegarde ◄ " endif
    dup 4 = if 64 0 at-xy ." ► Précédente ◄ " endif
    dup 5 = if 84 0 at-xy ." ► Suivante ◄ " endif
    dup 6 = if 104 0 at-xy ." ► QUITTER ◄ " endif
;

: destination
    numopt 1 = if saisie_index endif
    numopt 2 = if saisie_ligne endif
    numopt 3 = if sauvegarde_fichier endif
    numopt 4 = if fiche_precedente endif
    numopt 5 = if fiche_suivante endif
    numopt 6 = if bye endif
;

: saisie ( --- numopt )
    1 39 at-xy ekey
    dup k-left = if numopt 1- to numopt endif
    dup k-right = if numopt 1+ to numopt endif
    13 = if destination endif
    numopt 0= if 1 to numopt endif
    numopt 7 = if 6 to numopt endif
;

: boucle
BEGIN
    saisie
    numopt menu
AGAIN
;


lect_fichier
eff_ecran
aff_fiche
numopt menu boucle

Le script de lancement du programme est :

#!/bin/bash

cd /home/mm/Applications/Forth/travail/
xterm -geometry 160X40 -fa "Monospace" -fs 10 -lc -bd blue -bg grey -fg black -e "gforth /home/mm/Applications/Forth/travail/carnet.fs"