formatowanie liczb

program formatujLiczby;

const k = 3;
      spacja = ' ';

type
    lista = ^elemlisty;
    elemlisty = record
        w : char;
        nast : lista;
    end;

var f : Text;
    g : Text;

procedure wypiszListe(l : lista);
begin
    while l <> nil do begin
        write(l^.w);
        l := l^.nast;
    end;
    writeln;
end;

procedure stworzListe(var l, head : lista);
begin
    new(l);
    l^.nast := nil;
    head := l;
end;

procedure wstawZa(l : lista; const c : char);
var pom : lista;
begin
    new(pom);
    pom^.nast := l^.nast;
    pom^.w := c;
    l^.nast := pom;
end;

procedure usunNast(l : lista);
var pom : lista;
begin
    pom := l^.nast;
    l^.nast := l^.nast^.nast;
    dispose(pom);
end;

procedure wczytajLiczbe(l : lista; var f : text; var c : Char);
begin
    while not eoln(f) and (c <> spacja) do begin
        read(f, c);
        if c <> spacja then begin
            WstawZa(l, c);
            l := l^.nast;
        end;
    end;
end;

procedure usunMinusy(l : lista);
var stop : boolean;
begin
    stop := false;
    while not stop do begin
        if (l^.nast^.w = '-') and (l^.nast^.nast^.w = '-') then begin
            usunNast(l);
            usunNast(l);
        end
        else
            stop := true;
    end;
end;

procedure usunZeraCalowite(l : lista);
var stop:boolean;
begin
    stop := false;
    while (l^.nast^.w <> '.') and (l^.nast <> nil) and not stop do begin
        if l^.nast^.w = '-' then
            l := l^.nast
        else if (l^.nast^.w = '0') then begin
            if l^.nast^.nast <> nil then begin
                if l^.nast^.nast^.w <> '.' then
                    usunNast(l)
                else
                    stop := true
            end
            else
                stop := true;
        end
        else
            stop := true;
    end;
end;

function ulamek(l : lista) : boolean;
begin
    ulamek := false;
    while (l <> nil) and not ulamek do begin
        ulamek := l^.w = '.';
        l := l^.nast;
    end;
end;

procedure utnijDoK(l : lista; const k : Integer);
var i : integer;
begin
    while l^.w <> '.' do
        l := l^.nast;
    i := 1;
    while (i <= k) and (l <> nil) do begin
        l := l^.nast;
        inc(i);
    end;
    if l <> nil then
        while l^.nast <> nil do
            usunNast(l);
end;

procedure odwroc(var l : lista);
var j, k : lista;
begin
    if l <> nil then begin
        j := l^.nast;
        l^.nast := nil;
        while j <> nil do begin
            k := j^.nast;
            j^.nast := l;
            l := j;
            j := k;
        end;
    end;
end;

procedure usunZeraUlamkaIKropke(l : lista);
var pom : lista;
begin
    odwroc(l);
    while l^.w = '0' do begin
        pom := l;
        l := l^.nast;
        dispose(pom);
    end;
    if l^.w = '.' then begin
        pom := l;
        l := l^.nast;
        dispose(pom);
    end;
    odwroc(l);
end;

procedure liczbaZeremUsunMinus(head : lista);
begin
    if (head^.nast^.w = '-') and (head^.nast^.nast^.w = '0') and (head^.nast^.nast^.nast = nil) then
        usunNast(head);
end;

procedure wpiszDoPliku(h : lista; var g : text);
begin
    h := h^.nast;
    while h <> nil do begin
        write(g, h^.w);
        h := h^.nast;
    end;
    writeln(g);
end;

procedure usunListe(h : lista);
begin
    while h^.nast <> nil do
        usunNast(h);
    dispose(h);
end;

procedure formatujLiczby( var f, g : Text; const k : Integer);
var
    l, head : lista;
    c : Char;
begin
    reset(f);
    rewrite(g);
    while not eof(f) do begin
        while not eoln(f) do begin
            read(f, c);
            if c <> spacja then begin
                stworzListe(l, head);
                wstawZa(l, c);
                l := l^.nast;
                wczytajLiczbe(l, f, c);
                writeln('NOWA LICZBA');
                wypiszListe(head^.nast);
                //asset((c = spacja) or eoln(f));
                usunMinusy(head);
                writeln('usuniete minusy');
                wypiszListe(head^.nast);
                usunZeraCalowite(head);
                writeln('usuniete zera calkowite');
                wypiszListe(head^.nast);
                if ulamek(head^.nast) then begin
                    utnijDoK(head^.nast, k);
                    writeln('uciete do k');
                    wypiszListe(head^.nast);
                    usunZeraUlamkaIKropke(head^.nast);
                    writeln('zera ulamka usuniete');
                    wypiszListe(head^.nast);
                end;
                liczbaZeremUsunMinus(head);
                writeln('liczba zerem? usun minus');
                wypiszListe(head^.nast);
                writeln;
                wpiszDoPliku(head, g);
                usunListe(head);
            end;
        end;
        readln(f);
    end;
end;

//main
begin
    assign(f, 'in.txt');
    assign(g, 'out.txt');

    formatujLiczby(f, g, k);
    Close(f);
    Close(g);
end.