Informatika gyűjtemény

Egy szinttel feljebb fg_nyak.pas

2004050607080910

<<  4. óra  >>

<<  NYÁK  >>

NézetNyomtat

fg_nyak.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 2 KB
{
NYAK feladat megoldasa es tesztkornyezet
Feher Gabor, BDG Szakkor, 2006/2007, 4.ora

}
{$Q+}
PROGRAM bpont;
USES png, gd, baseunix, unix;
CONST
    maxn = 1000;

TYPE
    point = RECORD
        x, y: LONGINT;
    END;

VAR
    N: LONGINT;
    list: ARRAY [1..maxn] OF point;

FUNCTION min(a, b: LONGINT): LONGINT;
BEGIN
    IF (a < b) THEN min:= a
    ELSE min:= b;
END; {min}

PROCEDURE GetFraction(id: LONGINT; VAR x1, y1, x2, y2: LONGINT);
BEGIN
    x1:= list[id].x; y1:= list[id].y;
    IF (id = N) THEN id:= 1
    ELSE INC(id);
    x2:= list[id].x; y2:= list[id].y;
END; {GetFraction}

PROCEDURE dswap(VAR x1, y1, x2, y2: LONGINT);
VAR
    tmp: LONGINT;
BEGIN
    tmp:= x1; x1:= x2; x2:= tmp;
    tmp:= y1; y1:= y2; y2:= tmp;
END; {dswap}

FUNCTION Answer(x0, y0: LONGINT): BOOLEAN;
VAR
    i: LONGINT;
    cross, up, down: LONGINT;
    x1, y1, x2, y2: LONGINT;
BEGIN
    {WriteLn('question: ', x0, '-', y0);}
    cross:= 0; up:= 0; down:= 0;
    FOR i:= 1 TO N DO
    BEGIN
        GetFraction(i, x1, y1, x2, y2);
        IF y1 < y2 THEN dswap(x1, y1, x2, y2);
        {innentol y1 > y2}
        
        IF (y1 > y0) AND (y2 < y0) THEN
        BEGIN
            {Write(x1,',',y1,'-',x2,',',y2,' ');}
            IF (x1-x0)*(y1-y2)+(x2-x1)*(y1-y0) >= 0 THEN
            BEGIN
            {   Write(i, '! ');}
                INC(cross);
            END;
        END
        ELSE IF (y1 = y0) AND (x1 >= x0) THEN
        BEGIN
            IF (y2 > y0) THEN INC(up)
            ELSE IF (y2 < y0) THEN INC(down)
        END
        ELSE IF (y2 = y0) AND (x2 >= x0) THEN
        BEGIN
            IF (y1 > y0) THEN INC(up)
            ELSE IF (y1 < y0) THEN INC(down)
        END;
    END;
    {WriteLn;
    WriteLn(cross);
    WriteLn(cross, ' ', up, ' ', down);}
    cross:= cross+min(up, down);
    Answer:= cross MOD 2 = 1;
END; {Answer}

PROCEDURE Load(fname: STRING);
VAR
    be: Text;
    i: LONGINT;
BEGIN
    Assign(be, fname);
    {$i-} Reset(be); {$i+}
    IF IOResult <> 0 THEN
    BEGIN
        WriteLn('A fajlt nem tudom megnyitni.');
        HALT;
    END;
    ReadLn(be, N);
    FOR i:= 1 TO N DO
    BEGIN
        ReadLn(be, list[i].x, list[i].y);
    END;
    Close(be);
END;

PROCEDURE Prompt;
VAR
    x, y: LONGINT;
BEGIN
    {$i-} ReadLn(x, y); {$i+}
    WHILE (IOResult = 0) DO
    BEGIN
        IF Answer(x, y) THEN WriteLn('IGEN')
        ELSE WriteLn('NEM');
        {$i-} ReadLn(x, y); {$i+}
    END;
END; {Prompt}

PROCEDURE Main;
BEGIN
    IF ParamCount = 1 THEN
    BEGIN
        Load(ParamStr(1));
        Prompt;
    END
    ELSE
    BEGIN
        WriteLn('Haszn: ');
        WriteLn(ParamStr(0), ' bpont.be');
    END;
END; {Main}

BEGIN
    Main;
END.
(Vissza)