All pastes #393601 Raw Edit

Stuff

public text v1 · immutable
·published 2007-03-13 18:28 UTC
rendered paste body
//Robertas Jurkaitis, 8 grupe, 1 uzduotis, 7 variantas
//Nuskaito intext.txt, surikiuoja abeceles tvarka tuos zodzius, kurie turi dvibalsius, isveda i outtext.txt
program uzd1;
type mas=array[1..1000] of string;

//PATIKRINAM AR SIMBOLIS RAIDE

function check(ch:char):boolean;
var simboliai:string;
    n:integer;

begin
    check:=TRUE;
    simboliai:=',.! ?:;()-';
    for  n:=0 to 9 do
    begin
        if simboliai[n]=ch
        then check:=FALSE;
    end;
end;

//NUSKAITOM

procedure readz(var arr:mas; var wordnr:integer);
var intext:text;
    ch:char;
    word:string;

begin
    assign (intext ,'intext.txt');
    reset (intext);
    wordnr:= 0;
    word:='';
    while not EOF(intext) do
    begin
        read(intext, ch);
        if check(ch) {ar raide}
        then word:=concat(word, ch)
        else if word<>'' then  //jei butu pora skiriamuju simboliu ish karto nepadarao, kad butu iretpiamas @nulinis@ zodis
        begin
            wordnr:=wordnr+1;
            arr[wordnr]:=word;
            word:= '';
        end;
    end;
    close(intext);
end;

//SURIKIUOJAM

procedure sortz(var arr:mas; wordnr:integer);
var n, j:integer;
    temp:string;

begin
    for n:=1 to wordnr do
    begin
        for j:=n+1 to wordnr do
        begin
            if arr[n]>arr[j] then
            begin
                temp:=arr[n];
                arr[n]:=arr[j];
                arr[j]:=temp;
            end;
        end;
    end;
end;

//AR BALSE?

function arbalse(ch:char):boolean;
var z:integer;
    balses:string;

begin
    arbalse:=FALSE;
    balses:='AEIOUaeiou';
    for z:=0 to 9 do
    begin
        if balses[z]=ch
        then arbalse:=TRUE;
    end;
end;
    
    
//PATIKRINAM IR SPAUSDINAM

procedure checkprint(var arr:mas; wordnr:integer);
var outtext:text;
    n, m, z:integer;
    charas:char;

begin
    assign(outtext, 'outtext.txt');
    rewrite(outtext);

    for n:=1 to wordnr do
    begin
        for m:=1 to length(arr[n])-1 do
        begin
            if arbalse(arr[n][m]) and arbalse(arr[n][m+1]) then
            begin
                writeln(outtext, arr[n])
            end
            else arr[n]:='';
        end;
    end;
    close(outtext);
end;

//goahkfakdhak

var wordnr:integer;
    arr:mas;

begin
    readz(arr, wordnr);
    writeln('Nuskaitem');
    sortz(arr, wordnr);
    writeln('Surikiavom');
    checkprint(arr, wordnr);
    writeln('Baigta');
    readln();
end.