Informatika gyűjtemény

Egy szinttel feljebb fg_klickety.pas

2004050607080910

<<  3. óra  >>

<<  Klickety  >>

NézetNyomtat

fg_klickety.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: 6 KB
{
Feher Gabor, 2005. 11. 04.
- nem teljesen az oran megbeszeltek alapjan -
}
PROGRAM klick;
USES crt;
CONST
    maxSor = 16;
    maxOszlop = 10;

    szinek: ARRAY [1..5] OF BYTE = (red, green, blue, yellow, magenta);

TYPE
    mezo = RECORD
        szin: BYTE; {a mezo szine, 0 ha mar ures}
        jel: BOOLEAN; {az osszefuggo teruletek keresesenel hasznalom}
    END;

VAR
    {a tabla szelei nullakkal lesznek kitoltve, es ezt majd sokszor kihasznalom}
    tabla: ARRAY [0..maxSor+1, 0..maxOszlop+1] OF mezo;

    sor, oszlop: INTEGER; {a tabla (valoban hasznalt) sorai es oszlopai}

PROCEDURE Init;
VAR
    i, j: INTEGER;
BEGIN
    Write('sor= [1..', maxSor, ']: '); ReadLn(sor);
    IF (1 > sor) OR (sor > maxSor) THEN HALT;
    Write('oszlop= [1..', maxOszlop, ']: '); ReadLn(oszlop);
    IF (1 > sor) OR (sor > maxSor) THEN HALT;

    Randomize;
    FOR i:= 0 TO sor+1 DO
    BEGIN
        FOR j:= 0 TO oszlop+1 DO
        BEGIN
            tabla[i, j].szin:= 0;
            tabla[i, j].jel:= FALSE;
        END;
    END;
    FOR i:= 1 TO sor DO
    BEGIN
        FOR j:= 1 TO oszlop DO
        BEGIN
            tabla[i, j].szin:= Random(5)+1;
        END;
    END;
END; {Init}

{Eltavolitja a kijelolest}
PROCEDURE Torol;
VAR
    i, j: INTEGER;
BEGIN
    FOR i:= 1 TO sor DO
    BEGIN
        FOR j:= 1 TO oszlop DO
        BEGIN
            tabla[i, j].jel:= FALSE;
        END;
    END;
END; {Torol}

{
Kijeloli az s,o koordinatakat is tartalmazo egyszinu tartomanyt.
A visszateresi ertek a kijelolt mezok szama.}
FUNCTION Kijelol(s, o: INTEGER): INTEGER;
VAR
    i, j: INTEGER;
    szaml, szin: INTEGER;
    kesz: BOOLEAN;

    PROCEDURE Jelol(s, o: INTEGER);
    BEGIN
        IF (tabla[s, o].jel = FALSE) AND (tabla[s, o].szin = szin) THEN
        BEGIN
            INC(szaml);
            tabla[s, o].jel:= TRUE;
            kesz:= FALSE;
        END;
    END; {Jelol}

BEGIN
    tabla[s, o].jel:= TRUE; szaml:= 1;
    szin:= tabla[s, o].szin;
    IF szin = 0 THEN
    BEGIN
        Kijelol:= 0;
        EXIT;
    END;

    REPEAT
        kesz:= TRUE;
        FOR i:= 1 TO sor DO
        BEGIN
            FOR j:= 1 TO oszlop DO
            BEGIN
                IF (tabla[i, j].jel) AND (tabla[i, j].szin = szin) THEN
                BEGIN
                    Jelol(i+1, j  );
                    Jelol(i-1, j  );
                    Jelol(i  , j+1);
                    Jelol(i  , j-1);
                END;
            END;
        END;
    UNTIL kesz = TRUE;
    Kijelol:= szaml;
END; {Kijelol}

{Eltavolitja egy oszlopbol a kijelolt mezoket.}
PROCEDURE OszlopPottyant(o: INTEGER);
VAR
    i, j: INTEGER;
BEGIN
    {
    Fentrol lefele megyunk, ha talalunk ures mezot, akkor az osszes folotte levot
    lefele leptetjuk egyel, es megyunk tovabb....
    Vigyazat nem optimalis! ;-)
    }
    FOR i:= sor DOWNTO 1 DO
    BEGIN
        {itt azert fontos a WHILE ciklus, mert amikor kiveszek egy mezot, akkor
        a helyere odapottyanhat egy szinten megjelolt mezo}
        WHILE tabla[i, o].jel = TRUE DO
        BEGIN
            FOR j:= i DOWNTO 1 DO
            BEGIN
                tabla[j, o]:= tabla[j-1, o];
            END;
        END;
    END;
END; {OszlopPottyant}

{Az o oszloptol jobbra levo oszlopokat eltolja egyel balra.}
PROCEDURE OszlopHuz(o: INTEGER);
VAR
    i, j: INTEGER;
BEGIN
    FOR j:= o TO oszlop DO
    BEGIN
        FOR i:= 1 TO sor DO
        BEGIN
            tabla[i, j]:= tabla[i, j+1];
        END;
    END;
END; {OszlopHuz}

{A klickety szabalyainak megfeleloen eltunteti a kijelolt tartomanyt.}
PROCEDURE Leereszt;
VAR
    i: INTEGER;
BEGIN
    FOR i:= 1 TO oszlop DO
    BEGIN
        OszlopPottyant(i);
    END;

    {lehetne optimalizalni...}
    FOR i:= oszlop - 1 DOWNTO 1 DO
    BEGIN
        IF tabla[sor, i].szin = 0 THEN OszlopHuz(i);
    END;
END; {Leereszt}

{Torli a kepernyot es kirajzolja a palyat.}
PROCEDURE Kirajzol;
VAR
    i, j: INTEGER;

    PROCEDURE VSkala;
    VAR
        j: INTEGER;
    BEGIN
        Write('  [');
        FOR j:= 1 TO oszlop DO
        BEGIN
            Write(' ', CHR(j-1+ORD('A')));
        END;
        WriteLn(']');
    END; {VSkala}

BEGIN
    ClrScr;
    WriteLn('kilepesi parancs: bye');
    WriteLn('leszedes: sor betuje szokoz oszlop betuje');
    VSkala;
    FOR i:= 1 TO sor DO
    BEGIN
        Write('[',CHR(i-1+ORD('A')),']');
        FOR j:= 1 TO oszlop DO
        BEGIN
            IF tabla[i, j].szin = 0 THEN Write('  ')
            ELSE
            BEGIN
                TextColor( szinek[ tabla[i, j].szin ]);
                IF tabla[i, j].jel THEN Write('**')
                ELSE Write('##');
                TextColor(LightGray);
            END;
        END;
        Write('[',CHR(i-1+ORD('A')),']');
        WriteLn;
    END;
    VSkala;
END; {Kirajzol}

{Elemzi a palyat, kiir egy uzenetet, es TRUE val ter vissza ha vege a jateknak.}
FUNCTION Elemez: BOOLEAN;
VAR
   i, j: INTEGER;
   vanmezo, vanszedes: BOOLEAN;
   szin: BYTE;
BEGIN
    vanmezo:= FALSE;
    vanszedes:= FALSE;
    FOR i:= 1 TO sor DO
    BEGIN
        FOR j:= 1 TO oszlop DO
        BEGIN
            szin:= tabla[i, j].szin;
            IF szin <> 0 THEN
            BEGIN
                vanmezo:= TRUE;
                vanszedes:= (vanszedes) OR
                            (tabla[i+1, j  ].szin = szin) OR
                            (tabla[i-1, j  ].szin = szin) OR
                            (tabla[i  , j-1].szin = szin) OR
                            (tabla[i  , j+1].szin = szin);
            END;
        END;
    END;
    IF NOT vanmezo THEN WriteLn('Gratulalok, nyertel!');
    IF NOT vanszedes THEN WriteLn('Jatek vege.');
    Elemez:= NOT vanszedes;
END; {Elemez}

PROCEDURE Jatsz;
VAR
    s: STRING;
    ch1, ch3: CHAR;
    i, j: INTEGER;
BEGIN
    WHILE TRUE DO
    BEGIN
        Kirajzol;
        IF Elemez THEN
        BEGIN
             WriteLn('Nyomj meg egy billentyut!');
             IF ReadKey = #0 THEN ReadKey;
             BREAK;
        END;

        Write('>'); ReadLn(s);
        IF (s = 'bye') THEN
        BEGIN
            WriteLn('bye');
            BREAK;
        END;
        IF (Length(s) <> 3) THEN CONTINUE;

        ch1:= UpCase(s[1]); ch3:= UpCase(s[3]);
        i:= ORD(ch1)-ORD('A')+1;
        j:= ORD(ch3)-ORD('A')+1;
        IF (i < 1) OR (j < 1) OR (i > sor) OR (j > oszlop) THEN CONTINUE;

        IF Kijelol(i, j) > 1 THEN Leereszt;
        Torol;
    END;
END; {Jatsz}

BEGIN
    Init;
    ClrScr;
    Jatsz;
END.
(Vissza)