IDENTIFICATION DIVISION.
PROGRAM-ID. FORMTEST.
*
*		VISULISATION D'ECRANS FORMVAX
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. VAX-11.
OBJECT-COMPUTER. VAX-11.
*
SPECIAL-NAMES.
*	
    SYMBOLIC CHARACTERS 	
	NULX	SOHX	STXX	ETXX	EOTX	ENQX	ACKX	BELX	BSX
	TABX	LFX	VTX	FFX	CRX	GINX	GOUTX	DLEX	XONX
	DC2X	XOFX	DC4X	CTUX	CTVX	CTWX	CTXX	EMX	CTZX
	ESCX	FSX	GSX	RSX	USX
	VT52C	VT100C	DELX
    ARE
	001	002	003	004	005	006	007	008	009
	010	011	012	013	014	015	016	017	018
	019	020	021	022	023	024	025	026	027
	028	029	030	031	032
        065     097     128
	DECIMAL-POINT IS COMMA.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
77	SS-STATUS	PIC S9(9)	COMP.
77	LONG		PIC S9(4)	COMP.
77	TALLY-CTR		PIC S9(4)	COMP.
77	ST-STK			PIC XX.
77	STAT			PIC S99 COMP.
77	DSP-STAT		PIC +99.
77	NOECR			PIC 999 COMP.
77	TYP			PIC 999 COMP.
77	TYPA			PIC 999 COMP.
77	TYP1			PIC 999 COMP VALUE 1.
77	TYP2			PIC 999 COMP VALUE 2.
77	TYP3			PIC 999 COMP VALUE 3.
77	TYP4			PIC 999 COMP VALUE 4.
77	NOERR			PIC 999 COMP.
77	NOCHA			PIC 999 COMP.
77	SCCHA			PIC 999 COMP.
77	NOELEM			PIC 999 COMP.
77	STAT1			PIC S99 COMP.
77	STATA			PIC S99 COMP.
77	LI			PIC S999 COMP.
77	COL			PIC S999 COMP.
77	BUFL			PIC S999 COMP.
77	POSA			PIC S999 COMP VALUE ZERO.
77	MASKP			PIC S999 COMP VALUE 1.
*
77	I-L			PIC 999 COMP.
77	I-TRAV			PIC 999 COMP.
77	I-NOECR			PIC 999 COMP.
77	MAX-NOECR		PIC 999 COMP.
77	LAST-NOECR		PIC 999 COMP.
*
01	PF1.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(2) VALUE	"OR".
*
01	REP			PIC XXX.
01	REPX			PIC XXX.
01	REPN 			PIC 9(3).
*
01 TIPGROG1.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(2) VALUE	"#3".
		07	FILLER PIC X(9)	VALUE	SPACES.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
		07	FILLER PIC X(21) 	VALUE
			"Test Ecrans  FORM/VAX".
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
01 TIPGROG2.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(2) VALUE	"#4".
		07	FILLER PIC X(9)	VALUE	SPACES.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[1m".
		07	FILLER PIC X(21) 	VALUE
			"Test Ecrans  FORM/VAX".
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
01 TILIECR.
		07	FILLER PIC X(9) VALUE	SPACES.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[1m".
		07	FILLER PIC X(31) 	VALUE
			"Liste des ecrans du programme :".
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
*
01 TQUEST.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[1m".
		07	FILLER PIC X(30) 	VALUE
			"Quel ecran voulez-vous tester".
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
*
01 SORCHA.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[1m".
		07	FILLER PIC X(30) 	VALUE
			"Sortie sur le champ No".
		07	FILLER PIC X	VALUE	SPACES.
		07	CHASOR	PIC ZZZ9.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
*
01	Z-MESS			PIC X(100).
*
01	NETOY.
	02	CLEAR.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[2J".
	02	EXI-GRAPH.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(2) VALUE	"(B".
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(2) VALUE	")B".
	02	ATTOFF.
		07	FILLER PIC X	VALUE	ESCX.
		07	FILLER PIC X(3) VALUE	"[0m".
*
01	E-BUF.
	03	FILLER		PIC X(1000).
*
01	TAB-NOECR.
	02 T-NOECR	OCCURS 255.
		03	D-NOECR	PIC 999 COMP.
*
01	L-NOECR.
	02	TAB-ZNOECR	OCCURS 20.
		03 X-NOECR.
			05 Z-NOECR	PIC BZZ9.
/
PROCEDURE DIVISION.
DEB-PGM SECTION.
DEBUT.
*
INIT-FRM.
	MOVE 0 TO I-NOECR I-TRAV MAX-NOECR	I-L.
	MOVE 0 TO STAT.
	CALL "INIFRM" USING STAT.
	IF STAT < 0 STOP RUN.
LOOP-INIECR.
	ADD 1 TO I-TRAV.
	IF I-TRAV > 255 GO TO RETOUR.
	MOVE I-TRAV TO NOECR.
	MOVE  ZERO TO STAT.
	CALL "INIECR" USING NOECR STAT.	
	IF STAT < 0 GO TO LOOP-INIECR.
	ADD 1 TO I-NOECR MAX-NOECR.
	MOVE NOECR TO D-NOECR(I-NOECR) LAST-NOECR.
	GO TO LOOP-INIECR.
RETOUR.
	PERFORM ENTETE.
	MOVE 0 TO I-NOECR I-L.
	MOVE 9 TO LI.
	MOVE SPACES TO L-NOECR.
LOOP-DSP.
	ADD 1 TO I-NOECR.
	ADD 1 TO I-L.
	IF I-NOECR > MAX-NOECR   
			ADD 1 TO I-L
			MOVE "FIN" TO X-NOECR (I-L)
			GO TO SUITE.
	MOVE D-NOECR(I-NOECR) TO Z-NOECR (I-L).
	IF I-L > 19
			MOVE L-NOECR	TO Z-MESS
			ADD 1 TO LI
			MOVE 80		TO BUFL
			PERFORM AFFMESS
			MOVE SPACES TO L-NOECR
			MOVE 0	TO I-L.
	GO TO LOOP-DSP.
SUITE.
	IF I-L < 20
			MOVE L-NOECR	TO Z-MESS
			ADD 1 TO LI
			MOVE 80		TO BUFL
			PERFORM AFFMESS
			MOVE SPACES TO L-NOECR
			MOVE 50	TO I-L.
*	MOVE 40		TO BUFL.
SAINUM.
	MOVE TQUEST	TO Z-MESS.
	MOVE 24 TO LI.
	MOVE 1 TO COL.
 	CALL "SCR$ERASE_LINE"	USING BY VALUE 24 1.
 	CALL "SCR$SET_CURSOR"	USING BY VALUE 24 1.
	MOVE SPACES TO REP.
	CALL "SCR$GET_SCREEN"	USING	BY DESCRIPTOR	REP (1:3)
							Z-MESS(1:40)
					BY REFERENCE	BUFL
					GIVING SS-STATUS.
*
	MOVE REP TO REPX.
	IF REPX = "F" OR "FIN" OR "f" OR "fin" OR PF1 OR ESCX
					GO TO FIN.
	INSPECT REPX REPLACING ALL " " BY "0".
	IF REPX NOT NUMERIC CALL "SONNE"
			GO TO RETOUR.
	IF REP(1:3) = SPACE 	CALL "SONNE"
				GO TO RETOUR.
	IF REP (1:2) = SPACE MOVE "00" TO REP(1:2).
	IF REP (1:1) = SPACE MOVE "0" TO REP(1:1).
	MOVE ZERO TO TALLY-CTR .
	INSPECT REP TALLYING TALLY-CTR  FOR ALL SPACE.
	SUBTRACT TALLY-CTR   FROM 3 GIVING LONG.
	MOVE REP (1:LONG) TO REPN.
	IF REPN = ZERO		GO TO FIN.
	MOVE REPN TO NOECR.
	IF NOECR > LAST-NOECR CALL "SONNE"
				GO TO RETOUR.

INIT-E1.
	DISPLAY NETOY.
	MOVE  ZERO TO STAT.
	CALL "INIECR" USING NOECR STAT.	
	IF STAT < 0 
			MOVE STAT TO DSP-STAT	
		DISPLAY "ECRAN NO :" REPN " inconnu ou invalide  :" DSP-STAT
			call "valerr"
			GO TO retour.
	MOVE SPACES TO E-BUF.
	MOVE  ZERO TO STAT.
	MOVE 1 TO TYP.
SAISIE-E1.
	CALL "SAIECR" USING NOECR E-BUF TYP STAT.
	IF STAT < 0 GO TO retour.
	IF STAT = 0 GO TO AP-SAISIE-E1.
	GO TO AFFSORT.
AP-SAISIE-E1.
	MOVE 9 TO NOERR.
	CALL "AFFMSG" USING NOERR STAT1.
	GO TO RETOUR.
AFFSORT.
	MOVE STAT TO CHASOR.
	MOVE 40		TO BUFL.
	MOVE 40 TO COL.
	MOVE 24 TO LI.
	MOVE SPACES	TO Z-MESS.
	PERFORM AFFMESS
	CALL "SONNE"
	MOVE SORCHA	TO Z-MESS.
	PERFORM AFFMESS
	GO TO SAISIE-E1.
**
FIN-PGM SECTION.
FIN.
	CALL "EFFECR".
	DISPLAY NETOY "FIN...".
	STOP RUN.
*
ENTETE SECTION.
ENT1.
	CALL "EFFECR".
	DISPLAY NETOY.
	MOVE 1 TO LI.
	MOVE 1 TO COL.
	MOVE TIPGROG1	TO Z-MESS.
	MOVE 80			TO BUFL.
	PERFORM AFFMESS.
	MOVE TIPGROG2	TO Z-MESS.
	ADD 1 TO LI.
	PERFORM AFFMESS.
	MOVE TILIECR	TO Z-MESS.
	ADD 2 TO LI.
	PERFORM AFFMESS.
	ADD 1 TO LI.
ENTEX.
	EXIT.
*
AFFMESS SECTION.
*
AFF1.
	CALL "AFFTXT" USING LI COL Z-MESS BUFL STAT1.
	MOVE SPACES 		TO Z-MESS.
AFFEX.
	EXIT.
*
EFFMESS SECTION.
EFF1.
	MOVE SPACES 		TO Z-MESS.
	CALL "AFFTXT" USING LI COL Z-MESS BUFL STAT1.
EFFEX.
	EXIT.
*
