(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
(*                                                                           *)
(* PROGRAMA : DIF (Turbo Pascal Version)                                    *)
(*                                                                           *)
(* SUBSISTEMA :                                                              *)
(*                                                                           *)
(* AUTOR :  Bob Ponting                                                      *)
(*                                                                           *)
(* FECHA DE PROGRAMACION : 31 Enero 84                                       *)
(*                                                                           *)
(* FECHA ULTIMA CORRECCION : 27 Febrero 88                                   *)
(*                                                                           *)
(* OBJETIVO : Comparar dos archivos de texto, produciendo un listado de las  *)
(*            diferencias entre ellos.                                       *)
(*                                                                           *)
(* ENTRADAS :                                                                *)
(*                                                                           *)
(* SALIDAS : Listado por impresora, pantalla, o en un archivo                *)
(*                                                                           *)
(* REQUERIMIENTOS : Lineas con mas que 132 caracteres son troncadas.         *)
(*                                                                           *)
(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
{ $K0 these switches work with PASCAL MT+}
{ $K4}
{ $K7}
{ $K12}
{ $K13}
{ $K14}
{ $K15}
program dif;

const
    BLANK = ' ';
    NLINEAS = 3; {Cantidad de lineas iguales para comparar igual}
    VERSION = '2.0'; {Version de DIF}
    NCHARS = 80;
    DIV1 = '--------------------------------------------------------------------------------';
    DIV2 = '========================================';

type
{$I glbltype.pas}
    str = string[80];

    prioridad = (primero,segundo);

    ioOp = (resett,rerite,klose);

    itemptr = ^qitem;

    filename = string[15];

    qitem = record
                linea : string [132];
                anterior : itemptr;
                posterior : itemptr;
            end;

    q = record
           cantLineas : integer;
           cabeza,
           cola,
           matchAnt : itemptr;
           nombre : filename;
           archivo : text;
           orden : prioridad;
        end;

var
    hayIgualdades : boolean;
    nDifs : integer;
    q1, q2 : q;
    outfile : text;
    cNivel : integer;
    libre : itemptr;

{$I cmdprocs.pas}
{$I strint.pas}
{$I abort.pas}

function isdigit(c : char) : boolean;
begin
isdigit := c in ['0'..'9']
end;


procedure ioErrControl(fn : fileName; operacion : ioOp; ior : integer);
const
    ERR = 255;
begin
if ior = ERR then
    case operacion of
        resett,rerite :
            writeln('Error abriendo archivo ',fn);
        klose :
            writeln('Error cerrando archivo ',fn);
        end
end; {ioErrControl}


procedure abrirArchivos;
const
    DELIMITER = '-'; {caracter usado para seperar argumentos del 2do archivo}
var
    basura : boolean;
    i : integer;
    parms, tmp, outfn : str;

begin
initcmd;
if nargs < 2 then
   begin
   writeln('Argument error: DIF FILE1 FILE2 -MnDdPS');
   writeln('            Mn - consider ''n'' identical lines a match');
   writeln('            Dd - write difference file to disk ''d''');
   writeln('            P  - list differences to printer');
   writeln('            C  - list differences to console');
   abort('')
   end;
basura := getarg(1,tmp);
q1.nombre := tmp;

{Tomo nombre de archivo de diferencias del primer parametro}
outfn := q1.nombre;
i := pos('.',outfn);
if i > 0 then outfn := copy(outfn,1,i-1);
outfn := concat(outfn,'.DIF');

{Junto todo los argumentos en un string para procesar 2do archivo y parametros}
q2.nombre := '';
for i := 2 to nargs do
    begin
    basura := getarg(i,tmp);
    q2.nombre := concat(q2.nombre,tmp)
    end;
parms := '';
i := pos(DELIMITER,q2.nombre);
if i>0 then
    {hay parametros}
    begin
    parms := copy(q2.nombre,i,length(q2.nombre)-i+1);
    q2.nombre := copy(q2.nombre,1,i-1)
    end;
{proceso string de parametros, si hay}
cNivel := NLINEAS;
for i := 1 to length(parms) do
    case parms[i] of
        'D': if length(parms) > i then
              begin
              if (outfn[2] = ':') then outfn[1] := parms[i+1]
              else outfn := concat(parms[i+1],':',outfn);
              parms[i+1] := ' ';
              end;
        'M': if length(parms) > i then
                 cNivel := strint(copy(parms,i+1,1));
        'P': outfn := 'LST:';
        'C': outfn := 'CON:';
        end;

assign(q1.archivo,q1.nombre);
reset(q1.archivo);
ioErrControl(q1.nombre,resett,ioresult);
assign(q2.archivo,q2.nombre);
reset(q2.archivo);
ioErrControl(q2.nombre,resett,ioresult);
assign(outfile,outfn);
rewrite(outfile);
ioErrControl(outfn,rerite,ioresult);
end; {abrirArchivos}


procedure initQueue(var qrec : q; o : prioridad);
begin
with qrec do
    begin
    cabeza := nil;
    cola := nil;
    matchAnt := nil;
    cantLineas := 0;
    orden := o;
    end
end; {initQueue}


procedure cerrarArchivos;
var
    ior : integer;
begin
close(q1.archivo);
close(q2.archivo);
if nDifs < 1 then erase(outfile) else close(outfile)
end; {cerrarArchivos}


procedure centrar(var s : str; longLinea : integer);
const
    BLANCO = ' ';
var
    i : integer;
begin
for i := 1 to (longLinea-length(s)) div 2 do s := s + BLANCO
end; {centrar}


procedure titulo;
var
    tit : str;
begin
writeln(outfile,'DIF - Version ',VERSION);
writeln(outfile,'Copyright 1988 by Bob Ponting');
writeln(outfile);
tit := 'D I F F E R E N C E S   B E T W E E N   '+q1.nombre+' and  '+q2.nombre;
centrar(tit,NCHARS);
writeln(outfile,tit);
writeln(outfile,DIV1);
end; {titulo}


procedure imprimirDiferencias(dif1:itemptr; var q1:q;
                              dif2:itemptr; var q2:q; var nDif:integer);
var
    t : str;
    tmp : itemptr;

procedure impLista(prim, ult : itemptr);
begin
while (prim <> ult^.posterior) do
    begin
    writeln(outfile,prim^.linea);
    prim := prim^.posterior
    end;
end; {impLista}

begin
nDif := succ(nDif);

{imprimo numero de diferencia centrado en una linea de NCHARS caracteres}
intstr(nDif,t);
t := concat('Difference ',t);
centrar(t,NCHARS);
writeln(outfile,t);
writeln(outfile,DIV1);
writeln(outfile,'En ',q1.nombre,':');
if q1.matchAnt <> nil then
    tmp := q1.matchAnt^.posterior
else
    tmp := q1.cabeza;
impLista(tmp,dif1);
writeln(outfile,DIV2);
writeln(outfile,'En ',q2.nombre,':');
if q2.matchAnt <> nil then
    tmp := q2.matchAnt^.posterior
else
    tmp := q2.cabeza;
impLista(tmp,dif2);
writeln(outfile,DIV1)
end; {imprimirDiferencias}


procedure getItem( var item : itemptr);
{funcion : Conseguir un item nuevo de las lista libre o de memoria dinamica}
begin
if libre = nil then
    new(item)
else
    begin
    item := libre;
    libre := item^.posterior
    end
end; {getItem}


procedure dqueue(var lista : itemptr; var queue : q);
{funcion : librar qitems entre LISTA^ y la cabeza de la cola}
var
    tmp : itemptr;
begin
queue.cabeza := lista^.posterior;
queue.cabeza^.anterior := nil;
while (lista <> nil) do
    begin
    tmp := lista^.anterior;
    {poner item liberado en pila de items libres}
    lista^.posterior := libre;
    libre := lista;
    queue.cantLineas := pred(queue.cantLineas);
    lista := tmp
    end
end; {dqueue}


procedure queue(var item : itemptr; var lista : q);
{funcion : poner un ITEM en la cola Q}
begin
if lista.cabeza = nil then
    begin {cola vacia}
    lista.cabeza := item;
    lista.cola := item;
    lista.matchAnt := nil;
    item^.anterior := nil;
    item^.posterior := nil;
    end
else
    begin
    item^.anterior := lista.cola;
    item^.posterior := nil;
    lista.cola^.posterior := item;
    lista.cola := item
    end;
lista.cantLineas := succ(lista.cantLineas)
end; {queue}


function match(item1, match1Ant, item2, match2Ant : itemptr) : boolean;
{funcion : comparar dos listas de lineas para igualdad}
var
    nivel : integer;
    m : boolean;
begin
if hayIgualdades and (item1^.anterior=match1Ant) and
    (item2^.anterior=match2Ant) then
    {solamente comparar item1^ con item2^ porque no hay diferencias entre
     estas lineas y la ultima igualdad}
    nivel := 1
else
    nivel := cNivel;
repeat
    if (item1=nil) or (item2=nil) or
       (item1 = match1Ant) or (item2 = match2Ant) then
        m := false
    else
        begin
        m := (item1^.linea = item2^.linea);
        nivel := pred(nivel);
        item1 := item1^.anterior;
        item2 := item2^.anterior
        end
    until (nivel < 1) or (not m);
match := m
end; {match}


procedure compararLineas(var q1, q2 : q);
var
    itemNuevo, q2ptr, dif1, dif2 : itemptr;
    igual : boolean;
    i : integer;
begin
getItem(itemNuevo);
readln(q1.archivo,itemNuevo^.linea);
queue(itemNuevo,q1);
if (q2.matchAnt <> nil) then
    q2ptr := q2.matchAnt^.posterior
else
    q2ptr := q2.cabeza;
igual := false;
while (q2ptr <> nil) and (not igual) do
    if match(itemNuevo,q1.matchAnt,q2ptr,q2.matchAnt) then igual := true
    else q2ptr := q2ptr^.posterior;

if igual then
    begin
    hayIgualdades := true; {despues de la primer igualdad queda true}
    {sigo apuntadores hasta primer linea de la igualdad (un igualdad esta
     compuesta de CNIVEL lineas iguales)}
    dif1 := itemNuevo;
    dif2 := q2ptr;
    for i := 2 to cNivel do
        begin
        dif1 := dif1^.anterior;
        dif2 := dif2^.anterior
        end;
    {imprimo diferencias si quedan lineas no iguales antes de la igualdad}
    if (dif1^.anterior <> nil) and (dif2^.anterior <> nil) then
        begin
        if q1.orden = primero then
            imprimirDiferencias(dif1,q1,dif2,q2,nDifs)
        else
            imprimirDiferencias(dif2,q2,dif1,q1,nDifs)
        end;
    dqueue(dif1,q1);
    dqueue(dif2,q2);
    {guardo apuntadores a las lineas iguales}
    q1.matchAnt := itemNuevo;
    q2.matchAnt := q2ptr;
    end
end; {compararLineas}


begin
abrirArchivos;
initQueue(q1,primero);
initQueue(q2,segundo);
titulo;
nDifs := 0;
libre := nil;
hayIgualdades := false; {esta false hasta la primer igualdad}
while not(eof(q1.archivo)) or not(eof(q2.archivo)) do
    begin
    if not eof(q1.archivo) then compararLineas(q1,q2);
    if not eof(q2.archivo) then compararLineas(q2,q1)
    end;
if (q1.cantLineas>=cNivel) or (q2.cantLineas>=cNivel) then
    imprimirDiferencias(q1.cola,q1,q2.cola,q2,nDifs);
cerrarArchivos;
writeln;
if nDifs < 1 then writeln('No hay diferencias')
end. {dif}