	PROGRAM DIAPOS
C
C
C		Programme interactif de creation de transparents
C	sur ecran VT100 (ou compatibles).
C
C		*******************************************
C		*  Auteur: JP LAMARGOT  -- Decembre 1983  *
C		*******************************************
C
C		NB: utilisation de EDIDIA qui est une version derivee
C	de celui que l'on peut trouver dans la bande DECUS Anaheim Fall 82
C	(fichier KEDEDT.DEV).
C
C------ Declarations ---------------------------------------------------------
C------ Reservations ---------------------------------------------------------
	BYTE DIAPOS(1920)
	BYTE BNOM(11),BBAK(10)
	BYTE LIGNE(80)
	BYTE BREP
C------ Mise en commun de zones memoire --------------------------------------
C------ Initialisations ------------------------------------------------------
	DATA DIAPOS/1920*'@'/
	DATA ISIZE/0/
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C	Corps du programme
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	CALL VTERAS(2)
	CALL VTTEXT(8,1,1,10,'Editeur de transparents')
	CALL PCSTBM(20,24)
C------ Nom du fichier (extension .DIA par defaut) ---------------------------
30	CALL VTMCUR(4,1)
	CALL ASKS('Nom du fichier',BNOM,1,10)
		DO 10 I = 1,10
		IF (BNOM(I).NE.0) GO TO 10
		IF (BNOM(I).EQ.'.') GO TO 20
		BNOM(I) = '.'
		BNOM(I+1) = 'D'
		BNOM(I+2) = 'I'
		BNOM(I+3) = 'A'
		GO TO 20
10		CONTINUE
C------ Ni ".", ni "0" ===> erreur -------------------------------------------
	CALL VTTEXT(8,0,23,1,'DIAPOS-W-Nom de fichier incorrect')
	GO TO 30
C------ Erreur sur le "OPEN" avec TYPE=OLD -----------------------------------
40	CALL VTMCUR(22,1)
	CALL SGRR
	CALL ASKL('DIAPOS-W-Ce fichier n''existe pas. Voulez-vous le creer'
	1,BREP)
	CALL SGRP
	IF (BREP.EQ..FALSE.) GO TO 30
	IF (BREP.EQ..TRUE.) GO TO 50
	GO TO 50	
C------ Ouverture du fichier -------------------------------------------------
20	OPEN(UNIT=1,TYPE='OLD',ERR=40,NAME=BNOM)
C------ Lecture du fichier ---------------------------------------------------
	READ (1,100,END=60) DIAPOS
100	FORMAT(80A1)
60	CLOSE (UNIT=1)
		DO 120 I = 1,1920
		IF (DIAPOS(I).EQ.'@') GO TO 130
120		CONTINUE
130	ISIZE = I - 1
C------ Creation d'une copie (extension .BAK) --------------------------------
		DO 70 I = 1,10
		BBAK(I) = BNOM(I)
		IF (BNOM(I).NE.'.') GO TO 70
		BBAK(I+1) = 'B'
		BBAK(I+2) = 'A'
		BBAK(I+3) = 'K'
		GO TO 140
70		CONTINUE
140	OPEN (UNIT=1,TYPE='NEW',NAME=BBAK)
	WRITE (1,200,END=90) DIAPOS
200	FORMAT(1H+,80A1)
90	CLOSE (UNIT=1)
		DO 160 I = 1,ISIZE
		IF (DIAPOS(I).EQ."177) DIAPOS(I) = 0
160		CONTINUE
C------ Creation du transparent ----------------------------------------------
50	CALL VTMCUR(3,1)
	CALL VTERAS(0)
	CALL SGRP
	CALL PCOMR
	CALL PCSTBM(3,24)
	type 999,"35,"102		!Necessaire pour le traitement correct
999	format(1h ,a1,a1)		! des sequences "Escape" par TSX
	CALL EDIDIA(DIAPOS,ISIZE,80,1910,22,'#')
	CALL PCOMA
	CALL PCSTBM(1,24)
	CALL VTMCUR(3,1)
C------ Creation du nouveau fichier ------------------------------------------
	IF (ISIZE.EQ.0) GO TO 80
		DO 150 I = 1,1910
		DIAPOS(I) = DIAPOS(I+10)
		IF (DIAPOS(I).EQ.0) DIAPOS(I) = "177
150		CONTINUE
	OPEN (UNIT=1,TYPE='NEW',NAME=BNOM)
	WRITE (1,200,END=110) DIAPOS
110	CLOSE (UNIT=1)
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C	Fin du programme
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
80	CALL VTRIS
	STOP
	END
                                          