tldm-universe/Ardent/UV/APP.PROGS/035A

subroutine U035A( Resultat, Status, Param )
*******************************************************************************
*
*	Saisie en mode editeur pleine ligne
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	08/18/96 18335 MAA Added new code to port 9 to Siemens Nixdorf.
*	01/14/91 7930  JWT Added new Ucode for Siemens/Nixdorf
*	17/07/89   -   BHX creation du source
*	10/09/90   -   BHX Abandon de PTERM => TTYGET / TTYSET
*
*******************************************************************************
*
$INCLUDE	UNIVERSE.INCLUDE	TTY
$INCLUDE	UNIVERSE.INCLUDE	DEF.USERS
$INCLUDE	UNIVERSE.INCLUDE	TERMINFO
***	validiter de la demande
	Status = 0
	Resultat = ""
	Nombre = 1
	Position = 1
	TTYGET tty$ ELSE Status = 1 ; RETURN
	SAVE.NL = CRMODE.ICRNL
	CRMODE.ICRNL = 0
	TTYSET tty$ ELSE Status = 1 ; RETURN
	Long = EXTRACT(Param,1)
	CarVal = EXTRACT(Param,2)
	ValIni = EXTRACT(Param,3)
	IF LEN(ValIni) > Long THEN ValIni = ValIni[1,Long]
	PRINT ValIni:
	UnCarAGauche = KEY.MOVE.CURSOR.LEFT
	FOR Indice = 1 TO LEN(ValIni)
		PRINT UnCarAGauche:
	NEXT Indice
	Resultat = ValIni:SPACE(Long-LEN(ValIni))
********
debut: *
********
***	saisie d'un caractere quelconque de CHAR(0) a CHAR(255)
	Command = KEYIN()
***	Inversion upcase/downcase
	IF CASE.INVERT THEN
		IF Command >= 'a' AND Command <= 'z' THEN
			Command = CHAR(SEQ(Command)-32)
		END ELSE
			IF Command >= 'A' AND Command <= 'Z' THEN
				Command = CHAR(SEQ(Command)+32)
			END
		END
	END
***	test du caractere recu
	Flag = 0
	BEGIN CASE
***		Caractere de validation
		CASE INDEX(CarVal,Command,1) > 0
		     Flag = 1
		     GOTO fin
***		fleche a gauche (^Y ; basckspace sans effacement?)
		CASE Command = KEY.MOVE.CURSOR.LEFT
		     Command = ""
		     IF Nombre = 1 THEN
			PRINT BELL:
		     END ELSE
			Flag = 2
			Nombre = Nombre - 1
 			GOSUB Reafficher
		     END
***		fleche a droite (^X)
		CASE Command = KEY.MOVE.CURSOR.RIGHT
		     Command = ""
		     IF Nombre < LEN(Resultat) THEN
			Flag = 3
			Nombre = Nombre + 1
 			GOSUB Reafficher
		     END ELSE
			PRINT BELL:
		     END
***		touche Mot (^B) suppression du caractere courant
		CASE Command = Mot OR Command = KEY.BACKSPACE OR Command = CHAR(02)
		     Command = ""
		     Resultat = Resultat[1,Nombre-1]:Resultat[Nombre+1,LEN(Resultat)-Nombre]:" "
		     GOSUB Reafficher
		     Flag = 4
***		touche Car (^A) insertion d'un blanc devant le caractere courant
		CASE Command = Car OR Command = CHAR(01)
		     Command = ""
		     Resultat = Resultat[1,Nombre-1]:" ":Resultat[Nombre,LEN(Resultat)-Nombre]
		     GOSUB Reafficher
		     Flag = 5
***		touche Supp suppression de la partie droite caractere courant compris
		CASE Command = Supp OR Command = CHAR(03)
		     Command = ""
		     IF Nombre # 1 THEN
***			     Nombre = Nombre - 1
			     Resultat = Resultat[1,Nombre-1]:Space(LEN(Resultat)-Nombre+1)
		     END ELSE
			     Resultat = Space(LEN(Resultat))
		     END
		     GOSUB Reafficher
		     Flag = 6
	END CASE
***	si caractere de controle autre que ceux prevu, l'absorber
	IF (Command < CHAR(32) OR Command > CHAR(249)) THEN
		IF Flag = 0 THEN
			GOTO debut
		END
	END
***	si longueur atteinte
	IF Nombre = Long + 1 THEN
		Command = ""
		PRINT BELL:
	END
***	mise a jour du resultat
	IF Command # "" THEN
		Resultat = Resultat[1,Nombre-1]:Command:Resultat[Nombre+1,LEN(Resultat)-Nombre]
		Nombre = Nombre + 1
		GOSUB Reafficher
	END
	GOTO debut
*******
fin : *
*******
***	suppression des blancs de fin de ligne
	Temp = Resultat
	FOR Indice = LEN(Resultat) TO 1 STEP -1
		IF Resultat[Indice,1] = " " THEN
			Temp = Temp[1,Indice-1]
		END ELSE
			GOTO LSuite
		END
	NEXT Indice
LSuite:	Resultat = Temp
	IF Resultat = ValIni THEN Modif = 0 ELSE Modif = 1
	Resultat = Resultat:@AM:Command:@AM:Modif
	CRMODE.ICRNL = SAVE.NL
	TTYSET tty$ ELSE Status = 1 ; RETURN
	RETURN
*************
Reafficher: *
*************
	FOR Indice = 1 TO Position - 1
		PRINT UnCarAGauche:
	NEXT Indice
	PRINT Resultat:
	Position = Nombre
	FOR Indice = LEN(Resultat) TO Nombre STEP -1
		PRINT UnCarAGauche:
	NEXT Indice
	RETURN
END