prostak.pas

{ Da bi se program uspesno preveo idite na Options->Mode...
  i izaberite "Release" }

program prostak;

uses crt;

{ Tipovi promenljivih }
type
    lwarray = array of longword; { Zbog istorijskih razloga funkcija ne sme da
                                   vraca promenljivi niz, ali ako se deklarise
                                   novi tip, onda moze }

{ Konstante }
const
    escape_char : char = #27;

{ Konstante }
const
    prvi_prosti : longword = 2;

{ Eratostenovo sito - algoritam za pronalazenje prostih brojeva
  - vraca niz svih prostih brojeve od 2 do m }
function esito(m : longword) : lwarray;
var
    i, p, psqr, n : longword;
    marked : boolean;
begin
    { Dodeli niz }
    setlength(esito, m - prvi_prosti);

    { Popuni niz }
    for i := prvi_prosti to m do
        esito[i-prvi_prosti] := i;

    { Eratostenovo sito }
    p := prvi_prosti;
    psqr := sqr(p);
    while true do
    begin
        { Oznaci brojeve na osnovu trenutnog prostog broja }
        marked := false;
        n := p;
        i := psqr;
        while i <= m do
        begin
            if esito[i-prvi_prosti] <> 0 then
            begin
                esito[i-prvi_prosti] := 0;
                marked := true;
            end;

        n := n + 1;
        i := p * n;
        end;
        { Ako nema oznacenih brojeva ili ako je kvadrat trenutnog prostog broja
          veci od gornje granice, onda prekini petlju: prekrizeni su svi
          kompozitni brojevi }
        if marked = false then break;
        if psqr > m then break;

        { Odredi sledeci prosti broj }
        for i := p + 1 to m do
        begin
            if esito[i-prvi_prosti] <> 0 then
            begin
                p := esito[i-prvi_prosti];
                break;
            end;
        end;

        psqr := sqr(p);
    end;
end;

{ Nadji proste brojeve od a do b }
function nadji_proste(a, b : longword) : lwarray;
var
    i, k, j : longword;
begin
    if a < prvi_prosti then
        a := prvi_prosti;

    if a >= b then
        setlength(nadji_proste, 0)
    else
    begin
        nadji_proste := esito(b);
        k := b - a;
        j := a - prvi_prosti;

        for i := 0 to k do
        begin
            nadji_proste[i] := nadji_proste[i+j];
        end;

        setlength(nadji_proste, k);
    end;
end;

{ Proverava da li je broj prost }
function da_li_je_prost(p : longword) : boolean;
var
    x : longword;
    prosti : lwarray;
begin
    da_li_je_prost := false;

    if p > prvi_prosti then
    begin
        prosti := esito(p + 1);
        x := p;
        while x <= p do
        begin
            if prosti[x] = p then
            begin
                da_li_je_prost := true;
                break;
            end;

            x := x - 1;
        end;
    end;
end;

{ Ispisuje niz prostih brojeva
  - svakih x brojeva ce procedura sacekati da korisnik pristisne dugme }
procedure ispisi_proste(prosti : lwarray; x : longword);
var
    i, j, l : longword;
begin
    j := 0;
    l := length(prosti);
    for i := 0 to l do
    begin
        if prosti[i] <> 0 then
        begin
            if (j <> 0) and (j mod x = 0) then
                if readkey() = escape_char then break;

            writeln(prosti[i]);
            j := j + 1;
        end;
    end;
end;

{ Prikazi meni i vrati odabranu stavku }
function meni(naslov : string; izbori : array of string) : integer;
const
    duzina_dekoracije : integer = 5;
var
    maxl, nsl, i, j, l, brizbora : integer;
    st : string;
begin
    { Nadji duzinu najduze linije koja ce biti prikazana }
    nsl := length(naslov);
    maxl := nsl;
    for st in izbori do
    begin
        l := length(st);
        if l > maxl then
            maxl := l;
    end;
    brizbora := length(izbori); str(brizbora, st);
    maxl := maxl + length(st) + duzina_dekoracije;

    { Ispisi gornju granicu menija }
    write(' ');
    for i := 0 to maxl - 2 do write('-');
    writeln(' ');

    { Ispisi naslov }
    write('|');
    l := maxl - nsl;
    j := l div 2;
    for i := 1 to l - 2 do
    begin
        if i = j then
            write(' ', naslov, ' ')
        else write('=');
    end;
    writeln('|');

    { Ipisi gornju granicu naslova }
    write('|');
    for i := 0 to maxl - 2 do write('=');
    writeln('|');

    { Ipisi donju granicu naslova }
    write('|');
    for i := 0 to maxl - 2 do write('=');
    writeln('|');

    { Ispisi izbore }
    for i := 0 to brizbora - 1 do
    begin
        write('| ', i + 1, '. ');
        write(izbori[i]);
        l := maxl - length(izbori[i]) - duzina_dekoracije;
        for j := 1 to l do write(' ');
        writeln('|');
    end;

    { Ispisi donju granicu menija }
    write(' ');
    for i := 0 to maxl - 2 do write('-');
    writeln(' ');

    write('> ');
    meni := integer(readkey()) - integer('0');
end;

{ Pocetak programa }
var
    a, b : longword;
    prosti : lwarray;
    treba_izaci : boolean;
    izbori : array [1..3] of string;
    izb : integer;
begin
    izbori[1] := 'Nadji sve proste brojeve u odredjenom opsegu';
    izbori[2] := 'Proveri da li je broj prost ';
    izbori[3] := 'Izadji';
    treba_izaci := false;

    while not treba_izaci do
    begin
        clrscr();
        izb := meni('PROSTAK', izbori);
        clrscr();

        case izb of
            1: begin
                write('Unesite granice opsega: ');
                readln(a, b);

                writeln('Radim...');
                writeln();
                prosti := nadji_proste(a, b);
                if length(prosti) = 0 then
                    writeln('Granice su neodgovarajuce!')
                else
                    ispisi_proste(prosti, 20);

                readkey();
            end;
            2: begin
                write('Unesite broj: ');
                readln(a);

                write('Broj ... ');
                if not da_li_je_prost(a) then
                    write('ni');
                writeln('je prost.');

                readkey();
            end;
            3: treba_izaci := true
            else
            begin
                writeln('Nepostojeca komanda!');
                readkey();
            end;
        end;
    end;
end.