PROGRAM VTTEST C C Fonction: Test des modules de la VTLIB C BYTE REP(80) CALL VTERAS(2) CALL VTMCUR(10,1) TYPE *,'Ce programme illustre l''utilisation de chaque fonction' TYPE *,' de la bibliotheque VTLIB' CALL VTMCUR(20,1) TYPE *,'Au prealable, vous devez avoir execute la commande' TYPE *,' SET TT TAB' TYPE *,'On continue [O/N] ? ' ACCEPT 1,REP 1 FORMAT(80A1) IF (REP(1).EQ.'N') STOP IF (REP(1).NE.'O') STOP C----- Test de la fonction VTSTBM (Definition de la zone de scrolling) ------- CALL VTERAS(2) CALL VTSTBM(10,12) DO 10 I = 1,30 TYPE *,'VTSTBM-I-Scrolling entre les lignes 10 et 12' 10 CONTINUE PAUSE 'VTSTBM-I-Tapez pour continuer' CALL VTSTBM(1,24) DO 20 I = 1,30 TYPE *,'VTSTBM-I-Scrolling sur la totalite de l''ecran' 20 CONTINUE PAUSE 'VTSTBM-I-Tapez pour continuer' C------ Test de la fonction VTERAS (Effacements de l'ecran) ------------------ CALL VTERAS(2) DO 30 I = 1,3 TYPE 6,"33 6 FORMAT(1H+,A1,'#8') CALL VTMCUR(12,40) CALL VTERAS(I-1) TYPE *,'VTERAS-I-Effacement de l''ecran IARG =',I-1 PAUSE 'VTERAS-I-Tapez pour continuer' 30 CONTINUE C------ Test de la fonction VTMCUR (Mouvements du curseur) ------------------- CALL VTERAS(2) CALL VTMCUR(10,10) TYPE *,'VTMCUR-I-Curseur deplace en ligne 10, colonne 10' PAUSE 'VTMCUR-I-Tapez pour continuer' C------ Test de la fonction VTTEXT (Ecriture de texte) ----------------------- CALL VTERAS(2) DO 40 I = 1,3 DO 50 J = 1,16 CALL VTELIN(2,20) CALL VTTEXT(J-1,I-1,10,4,'Salut') CALL VTMCUR(20,1) PAUSE 'VTTEXT-I-Tapez pour continuer' 50 CONTINUE CALL VTERAS(2) CALL VTMCUR(20,1) 40 CONTINUE C----- Test de la fonction VTLED (Controle des LED) -------------------------- CALL VTERAS(2) DO 60 I = 1,4 CALL VTLED(I) PAUSE 'VTLED-I-Tapez pour continuer' 60 CONTINUE CALL VTLED(0) PAUSE 'VTLED-I-Tapez pour continuer' C------ Test de la fonction VTGCUR (Position courante du curseur) ------------ CALL VTERAS(2) CALL VTGCUR(ILIGNE,ICOLON) TYPE *,'VTGCUR-I-Le curseur etait en ligne',ILIGNE,'colonne',ICOLON PAUSE 'VTGCUR-I-Tapez pour continuer' C------ Test de la fonction VTDBLW (Commutation simple <---> double largeur) - CALL VTERAS(2) TYPE 6,"33 CALL VTDBLW(10,1) TYPE *,'VTBLW-I-Ligne 10 en double largeur' PAUSE 'VTDBLW-I-Tapez pour continuer' CALL VTDBLW(10,0) TYPE *,'VTDBLW-I-Ligne 10 en simple largeur' PAUSE 'VTDBLW-I-Tapez pour continuer' C------ Test de la fonction VTCOL (Commutation 80 <---> 132 colonnes) -------- CALL VTCOL(1) PAUSE 'VTCOL-I-Tapez pour continuer' CALL VTCOL(0) PAUSE 'VTCOL-I-Tapez pour continuer' C------ Test fonction VTSCRL (Commutation defilement sauts <---> continu) ---- CALL VTERAS(2) CALL VTSCRL(1) DO 70 I = 1,30 TYPE *,'VTSCRL-I-Defilement continu' 70 CONTINUE PAUSE 'VTSCRL-I-Tapez pour continuer' CALL VTERAS(2) CALL VTSCRL(0) DO 80 I = 1,30 TYPE *,'VTSCRL-I-Defilement par sauts' 80 CONTINUE PAUSE 'VTSCRL-I-Tapez pour continuer' C------ Test de la fonction VTSCRN (Commutation fond sombre <---> clair) ----- CALL VTERAS(2) CALL VTSCRN(0) PAUSE 'VTSCRN-I-Tapez pour continuer' CALL VTSCRN(1) PAUSE 'VTSCRN-I-Tapez pour continuer' C------ Test de la fonction VTELIN (Effacements de ligne) -------------------- CALL VTERAS(2) DO 90 I = 1,3 TYPE 6,"33 CALL VTMCUR(12,40) CALL VTELIN(I-1,10) CALL VTMCUR(20,1) IF (I.NE.3) TYPE *,'VTELIN-I-Effacement Ligne courante 1 IARG =',I-1 IF (I.EQ.3) TYPE *,'VTELIN-I-Effacement Ligne 10 IARG =',I-1 PAUSE 'VTELIN-I-Tapez pour continuer' 90 CONTINUE C------ Test de la fonction VTANSI (Commutation ANSI <---> VT52) ------------- CALL VTERAS(2) CALL VTANSI(1) TYPE *,'VTANSI-I-Terminal en mode VT52' PAUSE 'VTANSI-I-Tapez pour continuer' CALL VTANSI(0) TYPE *,'VTANSI-I-Terminal en mode ANSI' PAUSE 'VTANSI-I-Tapez pour continuer' C------ Test de la fonction VTCGC (Sauvegarder/Restaurer Curseur, Mode C d'ecriture et jeu de carateres) ------------------------------ CALL VTERAS(2) CALL VTCGC(1) TYPE *,'VTCGC-I-Sauvegarde' PAUSE 'VTCGC-I-Tapez pour continuer' CALL VTCGC(0) TYPE *,'VTCGC-I-Restitution' PAUSE 'VTCGC-I-Tapez pour continuer' C------ Test de la fonction VTDBLH (Commutation Simple <---> Double hauteur) - CALL VTERAS(2) TYPE 6,"33 CALL VTDBLH(10,1) TYPE *,'VTDBLH-I-Ligne 10 en double hauteur' PAUSE 'VTDBLH-I-Tapez pour continuer' CALL VTDBLH(10,0) TYPE *,'VTDBLH-I-Ligne 10 en simple hauteur' PAUSE 'VTDBLH-I-Tapez pour continuer' C------ Test de la fonction VTDCUR (deplacements du curseur) ----------------- CALL VTERAS(2) TYPE *,'VTDCUR-I-Deplacement du curseur de 5 positions' DO 100 I = 1,4 CALL VTMCUR(12,40) CALL OUTSTR('x') CALL VTDCUR(5,I-1) CALL OUTSTR('y') CALL VTMCUR(20,1) PAUSE 'VTDCUR-I-Tapez pour continuer' 100 CONTINUE C------ Test de la fonction VTINDX (Commutation index normal <---> inverse) -- CALL VTERAS(2) TYPE 6,"33 CALL VTMCUR(1,1) PAUSE 'VTINDX-I-Tapez pour continuer' DO 110 I = 1,30 DO 115 K = 1,5000 115 CONTINUE CALL VTINDX(1) 110 CONTINUE PAUSE 'VTINDX-I-Tapez pour continuer' TYPE 6,"33 DO 120 I = 1,30 DO 125 K =1,5000 125 CONTINUE CALL VTINDX(0) 120 CONTINUE PAUSE 'VTINDX-I-Tapez pour continuer' C------ Test de la fonction VTSCS (Commutation caracteres alpha <---> graph) - CALL VTERAS(2) TYPE *,'VTSCS-I-Caracteres graphiques' CALL VTSCS(1) TYPE *,'lqqqqqwqqqqqk' TYPE *,'x x x' TYPE *,'tqqqqqnqqqqqu' TYPE *,'x x x' TYPE *,'mqqqqqvqqqqqj' CALL VTSCS(0) PAUSE 'VTSCS-I-Tapez pour continuer' TYPE *,'VTSCS-I-Caracteres alphanumeriques' TYPE *,'lqqqqqwqqqqqk' TYPE *,'x x x' TYPE *,'tqqqqqnqqqqqu' TYPE *,'x x x' TYPE *,'mqqqqqvqqqqqj' PAUSE 'VTSCS-I-Tapez pour continuer' C------ Test fonction VTKPAD (Commutation clavier numerique <---> special) --- CALL VTERAS(2) CALL VTKPAD(1) TYPE *,'VTKPAD-I-Utilisez le clavier auxiliaire (mode special)' TYPE *,' puis tapez ' ACCEPT 1,REP PAUSE 'VTKPAD-I-Tapez pour continuer' CALL VTKPAD(0) TYPE *,'VTKPAD-I-Utilisez le clavier auxiliaire (mode numerique)' TYPE *,' puis tapez ' ACCEPT 1,REP PAUSE 'VTKPAD-I-Tapez pour continuer' C------ Test de la fonction VTTAB (Controle des tabulateurs) ----------------- CALL VTERAS(2) TYPE *,'VTAB-I-Tabulateurs en position normale' TYPE *,'Tapez 3 fois puis ' ACCEPT 1,REP CALL VTTAB(1) TYPE *,'VTTAB-I-Plus de tabulateurs' TYPE *,'Tapez 3 fois puis ' ACCEPT 1,REP DO 130 I = 1,3 TYPE 2 2 FORMAT(1H$,' ') CALL VTTAB(2) 130 CONTINUE TYPE *,'VTTAB-I-Tabulateurs tous les 15 caracteres' TYPE *,'Tapez 3 fois puis ' ACCEPT 1,REP TYPE 2 CALL VTTAB(0) TYPE *,'VTTAB-I-Suppression du premier tabulateur' TYPE *,'Tapez 3 fois puis ' ACCEPT 1,REP PAUSE 'VTTAB-I-Tapez pour continuer' C------ Test de la fonction VTLFNL (Commutation LF <---> NL) ----------------- CALL VTERAS(2) CALL VTLFNL(1) TYPE *,'VTLFNL-I- genere pour chaque recu' TYPE 3,"12,"12,"12 3 FORMAT(1H ,3('Salut',A1)) PAUSE 'VTLFNL-I-Tapez pour continuer' CALL VTLFNL(0) TYPE *,'VTLFNL-I-Seul est genere pour chaque recu' TYPE 3,"12,"12,"12 PAUSE 'VTLFNL-I-Tapez pour continuer' PAUSE 'VTLFNL-I-Tapez pour continuer' C------ Test de la fonction VTCURK (Commutation touches flechees curseur <---> C application) ------------------------------------------------- CALL VTERAS(2) CALL VTCURK(1) TYPE *,'VTCURK-I-Utilisez les touches flechees (mode special)' TYPE *,' puis tapez ' ACCEPT 1,REP PAUSE 'VTCURK-I-Tapez pour continuer' CALL VTCURK(0) TYPE *,'VTCURK-I-Utilisez les touches flechees (mode normal)' TYPE *,' puis tapez ' ACCEPT 1,REP PAUSE 'VTCURK-I-Tapez pour continuer' C------ Test fonction VTORGN (Commutation adressage absolu <---> relatif) ---- CALL VTERAS(2) CALL VTSTBM(10,12) CALL VTORGN(1) CALL VTMCUR(1,1) TYPE *,'VTORGN-I-Adressage relatif 1ere ligne (scrolling 10-12)' PAUSE 'VTORGN-I-Tapez pour continuer' CALL VTERAS(2) CALL VTSTBM(1,24) CALL VTORGN(0) CALL VTMCUR(1,1) TYPE *,'VTORGN-I-Adressage absolu 1ere ligne (scrolling 1-24)' PAUSE 'VTORGN-I-Tapez pour continuer' C------ Test de la fonction VTWRAP (Commutation wraparound on <---> off) ----- CALL VTERAS(2) CALL VTWRAP(1) TYPE *,'VTWRAP-I-Illustration du wraparound lorsque le texte est 1 de longueur nettement plus importante que la longueur d''une ligne' PAUSE 'VTWRAP-I-Tapez pour continuer' CALL VTWRAP(0) TYPE *,'VTWRAP-I-Illustration du wraparound lorsque le texte est 1 de longueur nettement plus importante que la longueur d''une ligne' TYPE *,'VTRWRAP-I-C''est pourtant le meme texte' PAUSE 'VTWRAP-I-Tapez pour continuer' C------ Test de la fonction VTARPT (Commutation autorepeat on <---> off) ----- CALL VTERAS(2) CALL VTARPT(1) TYPE *,'VTARPT-I-Appuyez en continu sur une touche puis ' ACCEPT 1,REP PAUSE 'VTARPT-I-Tapez pour continuer' CALL VTARPT(0) TYPE *,'VTARPT-I-Appuyez en continu sur une touche puis ' ACCEPT 1,REP PAUSE 'VTARPT-I-Tapez pour continuer' C------ Test de la fonction VTDSR (Device Status Report) --------------------- CALL VTERAS(2) CALL VTDSR(IETAT) TYPE *,'VTDSR-I-Valeur de IETAT =',IETAT PAUSE 'VTDSR-I-Tapez pour continuer' C------ Test de la fonction VTWAY (Who Are You ?) ---------------------------- CALL VTERAS(2) CALL VTWAY(JESUIS) TYPE *,'VTWAY-I-Valeur de JESUIS =',JESUIS PAUSE 'VTWAY-I-Tapez pour continuer' C----- Test de la fonction VTRIS (Reset to Initial State) -------------------- CALL VTERAS(2) CALL VTCOL(1) TYPE *,'VTRIS-I-Le VT100 va executer la meme sequence que lorsqu''il 1 est mis sous tension' TYPE *,'Lorsqu''il en aura termine, vous taperez ' PAUSE 'Tapez pour continuer' CALL VTRIS PAUSE C------ Fin des tests -------------------------------------------------------- STOP END