{+doc
+NOMBRE: gendefs
+CREACION: 30.9.99
+AUTORES: rch
+REGISTRO:
+TIPO: Unidad Pascal.
+PROPOSITO: definiciones generales para editor de datos murdoc
+PROYECTO: edmurdoc

+REVISION:
+AUTOR:
+DESCRIPCION:
-doc}

unit gendefs;
interface
uses
	sysutils;
	
var
	_UNIX_: boolean; { indica si los archivos a generar son para UNIX }

const
	ESC = #27;
	CEOF = chr(27);
	LF = chr(10);
	CR = chr(13);
	TAB = chr(9);

	Transparentes = [' ', LF, CR, TAB];
	{$IFDEF WINDOWS}
	Letras = ['a'..'z','A'..'Z','0'..'9','_','''','á','é','í','ó','ú','ñ','Ñ','?','$'];
	{$ELSE}
	Letras = ['a'..'z','A'..'Z','0'..'9','_','''',' ','‚','¡','¢','£','¤','¥','?','$'];
	{$ENDIF}

	Cualificadores = ['.','\','^','@','#'];
	Separadores = ['(',')', ',' , ';','[',']',':','|','{','}' , ''#9''];
	Separadores1 = ['(',')', ';','[',']',':','|','{','}' , ''#9''];
	PuntoComa = ['.',','];
	Operadores = ['+','-','*','=','/','<','>'];


type
	nreal= double;
	TNombreStr= string[8];
	TUnidsStr= string[3];
	TLAofInt= array[1..100] of integer;
	TLAofFloat= array[1..100] of nreal;
	TLAofNombre= array[1..100] of TNombreStr;

{ se¤aliza un error y detiene la ejecuci¢n del programa }
procedure error( s: string );
function IntToStr( i: integer ): string;
function IntToStr_( i, fCampo: integer ): string;
function FloatToStr_( m: nreal; fCampo, fDecs: integer ): string;
function StrToInt( s: string ): integer;
function StrToFloat( s: string ): nreal;
function HayPuntoComa (r:string; var i:integer):boolean;


procedure readln( var f: text; var r: string );
procedure writeln( var f: text; r: string );
procedure CambiarSimboloDecimal (var s:string; i:integer);

function textFind( var r: string; var f: text; strToFind: string): boolean;

function strAfter( s, sf: string ): string;
function strBefore( s, sf: string ): string;
function strFillLength (s: string; largo_final:integer):string;

function readListOfInt(
	var f: text;
	var ai: TLAofInt; n: integer;
	nombre: string ): integer;

function readListOfFloat(
	var f: text;
	var ai: TLAofFloat; n: integer;
	nombre: string ): integer;

function readListOfStr(
	var f: text;
	var ai: TLAofNombre; n: integer;
	nombre: string ): integer;


function nextpal( var r: string): string;
function nextpal1( var r: string; de_TXT:boolean): string;
function nextInt( var r: string): integer;
function nextFloat( var r: string): nreal;
function nextFloat1( var r: string; de_TXT:boolean): nreal;
function nextStr( var r: string): string;
function strPalabraNumero(s: string;PalabraNumero:integer; separador:string):string;

implementation

function nextpal( var r: string): string;
var
	buscando: boolean;
	j, i: integer;
	n: integer;
	ntf: integer;
begin
	i:= 1;
	n:= length( r );
	buscando:= true;
	while (i <= n)and buscando do
		if r[i] in Transparentes then
			inc(i)
		else
			buscando:= false;

	if buscando then
	begin
		r:= '';
		nextpal:= '';
		exit;
	end;

	j:= i;
	buscando:= true;
	while (j <= n) and buscando do
		if  r[j] in Separadores+Transparentes then
			buscando:= false
		else
			inc(j);
	ntf:= 0;
	while r[j-1-ntf] in Transparentes do
			inc( ntf );
	nextpal:= copy( r, i, j-i-ntf);
	if j >= n then
		r:= ''
	else
		delete( r, 1, j);
end;


function nextpal1( var r: string; de_TXT:boolean): string;
var
	buscando: boolean;
	j, i: integer;
	n: integer;
	ntf: integer;
begin
	i:= 1;
	n:= length( r );
	buscando:= true;
	while (i <= n)and buscando do
		if r[i] in Transparentes then
			inc(i)
		else
			buscando:= false;

	if buscando then
	begin
		r:= '';
		nextpal1:= '';
		exit;
	end;

	j:= i;
	buscando:= true;
	if de_TXT then
	begin
		while (j <= n) and buscando do
			if  r[j] in Separadores1 then
				buscando:= false
			else
				inc(j)
	end
	else
		while (j <= n) and buscando do
			if  r[j] in Separadores then
				buscando:= false
			else
				inc(j);


	ntf:= 0;
	while r[j-1-ntf] in Transparentes do
			inc( ntf );
	nextpal1:= copy( r, i, j-i-ntf);
	if j >= n then
		r:= ''
	else
		delete( r, 1, j);
end;




function nextFloat( var r: string): nreal;
begin
	nextFloat:= strToFloat( nextPal( r ));
end;

function nextFloat1( var r: string; de_TXT:boolean): nreal;
begin
	nextFloat1:= strToFloat( nextPal1( r, de_TXT ));
end;

function nextInt( var r: string): integer;
begin
	nextInt:= strToInt( nextPal( r ));
end;

function nextStr( var r: string): string;
var
	ts: string;
begin
	ts:= nextPal(r);
	ts:= strAfter(ts, '''');
	ts:= strBefore(ts, '''');
	nextStr:= ts;
end;


function HayPuntoComa( r: string; var i:integer): boolean;
var
	encontre: boolean;
	n: integer;
begin
	i:= 1;
	n:= length( r );
	encontre:= false;
	while (i <= n)and not encontre do
		if r[i] in PuntoComa then
			encontre:= true
		else
			inc(i);
	result:= encontre;
end;


procedure CambiarSimboloDecimal( var s: string; i:integer);
begin
	if s[i] = '.' then
		s[i]:= ','
	else if s[i] = ',' then
		s[i]:= '.'
end;


function readListOfInt(
	var f: text;
	var ai: TLAofInt; n: integer;
	nombre: string ): integer;

label
	fin;
var
	i: integer;
	r: string;
	res: integer;
begin
	res:= -1;
	if not textFind( r, f, nombre) then goto fin;
	r:= StrAfter(r, '=');
	i:= 1;
	while (length(r)> 0) and (i <= n) do
	begin
		ai[i]:= nextInt( r );
		inc(i);
	end;
	if i= n+1 then res:= 0
	else res:= -2;
fin:
	readListOfInt:= res;
end;


function readListOfFloat(
	var f: text;
	var ai: TLAofFloat; n: integer;
	nombre: string ): integer;

label
	fin;
var
	i: integer;
	r: string;
	res: integer;
begin
	res:= -1;
	if not textFind( r, f, nombre) then goto fin;
	r:= StrAfter(r, '=');
	i:= 1;
	while (length(r)> 0) and (i <= n) do
	begin
		ai[i]:= nextFloat( r );
		inc(i);
	end;
	if i= n+1 then res:= 0
	else res:= -2;
fin:
	readListOfFloat:= res;
end;


function readListOfStr(
	var f: text;
	var ai: TLAofNombre; n: integer;
	nombre: string ): integer;

label
	fin;
var
	i: integer;
	r: string;
	res: integer;
begin
	res:= -1;
	if not textFind( r, f, nombre) then goto fin;
	r:= StrAfter(r, '=');
	i:= 1;
	while (length(r)> 0) and (i <= n) do
	begin
		ai[i]:= nextStr( r );
		inc(i);
	end;
	if i= n+1 then res:= 0
	else res:= -2;
fin:
	readListOfStr:= res;
end;



procedure error( s: string );
begin
	raise Exception.Create( 'ERROR:: '+s );
end;

function IntToStr( i: integer ): string;
var
	s: string;
begin
	str( i, s );
	IntToStr:= s;
end;

function IntToStr_( i, fCampo: integer ): string;
var
	s: string;
begin
	str( i:fCampo, s );
	IntToStr_:= s;
end;

function FloatToStr_( m: nreal; fCampo, fDecs: integer ): string;
var
	s: string;
begin
	str( m:fCampo:fDecs, s );
	FloatToStr_:= s;
end;

function StrToInt( s: string ): integer;
var
	m, res: integer;
begin
	while pos(' ',s)> 0 do
		delete( s, pos(' ',s), 1 );
	val( s, m, res );
	if res <> 0 then error('StrToInt: '+s);
	StrToInt:= m;
end;

function StrToFloat( s: string ): nreal;
var
	res, i: integer;
	m: nreal;
begin
	i:= 0;
	val( s, m, res );
//	if res <> 0 then error('StrToFloat: '+s);
		if res <> 0 then
			if HayPuntoComa (s, i) then
			begin
				CambiarSimboloDecimal (s, i);
				val( s, m, res );
				if res <> 0 then error('StrToFloat: '+s);
			end;
	StrToFloat:= m;
end;

{ Lee una l¡nea sin importar si es UNIX o DOS }
procedure readln( var f: text; var r: string );
var
			c: char;
begin
			r:= '';
			c:='m';
			while not eof(f) and (c<> #10) do
			begin
					 read(f, c);
					 r:=r+c;
			end;
			if (c=#10) and (length(r) > 1) then  // agregue lo del length por lineas que solo tiene #10
				SetLength( r, length(r)-1);
			if r[length(r)]=#13 then
				setLength( r, length(r)-1);
end;

procedure writeln( var f: text; r: string );
var
	s:string;
begin
	if _UNIX_ then
		write(f, r, #10)
	else
		write(f, r, #13#10 );
	s:= r;
end;


function textFind(
	var r: string;
	var f: text; strToFind: string): boolean;
var
	buscando: boolean;
begin
	buscando:= true;
	while not eof(f)  and buscando do
	begin
		readln( f, r );
		if pos( strToFind, r ) > 0 then
			buscando:= false;
	end;
	textFind:= not buscando;
end;




function strAfter( s, sf: string ): string;
var
	i, n: integer;
	ts: string;
begin
	n:= length(s );
	i:= pos( sf, s );
	if (i> 0)and(i < n) then
		ts:= copy(s, i+1, n-i)
	else
		ts:= '';
	strAfter:= ts;
end;


function strBefore( s, sf: string ): string;
var
	i, n: integer;
	ts: string;
begin
	n:= length(s );
	i:= pos( sf, s );
	if (i> 0)and(i <= n) then
		ts:= copy(s, 1, i-1)
	else
		ts:= '';
	strBefore:= ts;
end;

function strPalabraNumero(s: string;PalabraNumero:integer; separador:string):string;
var
	res:string;
	buscando:boolean;
	largo, NroPalabra:integer;
begin
	largo:= length(s);
	buscando:= TRUE;
	NroPalabra:= 1;
	while (largo > 0) and (buscando) do
	begin
		res:= strBefore(s, separador);
		if NroPalabra = PalabraNumero then
			buscando := FALSE
		else
		begin
			s:= strAfter(s, separador);
			largo:= length(s);
			NroPalabra:= NroPalabra +1;
		end;
	end;
	result:= res;
end;

function strFillLength ( s: string; largo_final:integer):string;
var
	largo_inicial, i:integer;
	r:string;
begin
	largo_inicial:= length(s);
	r:= '';
	for i:= largo_inicial to largo_final do
		r:= r + ' ';
result:= r+ s;
end;


end.
