Coder en RPG full free, sans une seule colonne à compter

Programme 1 Hello world

Hello world : quatre lignes

**FREE
// HELLO : le premier programme en RPG full free
dsply 'Hello world !';
*inlr = *on;

**FREE

Obligatoire sur la première ligne, en colonne 1 : il annonce un source entièrement libre.

// HELLO : …

Un commentaire, jusqu'à la fin de la ligne.

dsply 'Hello world !';

Le littéral directement dans l'instruction, sans zone intermédiaire.

*inlr = *on;

Toujours LR pour terminer, sans EVAL. La casse est libre.

CRTBNDRPG PGM(JOBIRF/HELLO) SRCFILE(JOBIRF/QRPGLESRC) DBGVIEW(*SOURCE)
CALL HELLO

Programme 2 Sans écran, avec un PF à clé

Sortir du stock un article lu par sa clé

**FREE
// SORTIE : sortie de stock d'un article, sans ecran.
// Parametres : code article, quantite (5 chiffres),
// code retour : OK, INC (inconnu), INS (stock insuffisant)
dcl-f ARTICLE usage(*update) keyed;

dcl-pi *n;
  pCode char(5);
  pQteA char(5);
  pRet char(3);
end-pi;

dcl-s qte packed(5:0);

qte = %dec(pQteA:5:0);
chain pCode ARTICLE;
if not %found(ARTICLE);
  pRet = 'INC';
elseif qte > ARTSTK;
  pRet = 'INS';
else;
  ARTSTK -= qte;
  update ARTICLR;
  pRet = 'OK ';
endif;
*inlr = *on;

dcl-f ARTICLE usage(*update) keyed;

Le fichier, ouvert en mise à jour, lu par la clé. Le format (ARTICLR) et les zones (ARTCOD, ARTLIB, ARTSTK) viennent des DDS, comme avant.

dcl-pi *n; … end-pi;

Les trois paramètres reçus par le programme, avec leur type.

chain pCode ARTICLE; et if not %found(ARTICLE);

Lecture par la clé, puis test du résultat par %found.

ARTSTK -= qte;

Soustraction et affectation en une instruction.

Du colonné au libre, ligne à ligne

CRTBNDRPG PGM(JOBIRF/SORTIE) SRCFILE(JOBIRF/QRPGLESRC) DBGVIEW(*SOURCE)

Programme 3 Un écran, un PF et un LF

Consulter un article par son code ou par son libellé

Toujours l'écran ARTECR et le LF ARTICL1 de la page RPG III. Trois dcl-f, et la logique du RPG IV colonné, sans les colonnes :

**FREE
// ARTCON : consultation d'un article par son code (PF)
// ou par le debut de son libelle (LF). F3 pour sortir.
dcl-f ARTECR workstn;
dcl-f ARTICLE keyed;
dcl-f ARTICL1 keyed;

dow not *in03;
  exfmt ECRAN;
  if *in03;
    leave;
  endif;
  *in41 = *off;
  *in42 = *off;
  if ECODE <> *blanks;
    // Un code : acces direct par la cle du PF
    chain ECODE ARTICLE;
    *in41 = not %found(ARTICLE);
  else;
    // Sinon : positionnement dans le LF, puis lecture
    setll ERECH ARTICL1;
    read ARTICL1;
    *in42 = %eof(ARTICL1);
  endif;
  // Rien trouve : on vide la fiche
  if *in41 or *in42;
    clear ARTCOD;
    clear ARTLIB;
    clear ARTSTK;
  endif;
enddo;
*inlr = *on;

dcl-f ARTECR workstn;

L'écran : WORKSTN suffit, le fichier est alors en entrée et sortie.

dcl-f ARTICLE keyed;

Sans usage, un fichier DISK est en lecture seule.

*in41 = not %found(ARTICLE);

Les indicateurs 41 et 42 restent ceux des DDS : ils conditionnent les messages de l'écran.

CRTPF     FILE(JOBIRF/ARTICLE) SRCFILE(JOBIRF/QDDSSRC)
CRTLF     FILE(JOBIRF/ARTICL1) SRCFILE(JOBIRF/QDDSSRC)
CRTDSPF   FILE(JOBIRF/ARTECR) SRCFILE(JOBIRF/QDDSSRC)
CRTBNDRPG PGM(JOBIRF/ARTCON) SRCFILE(JOBIRF/QRPGLESRC) DBGVIEW(*SOURCE)
CALL ARTCON