Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

Zespół Szkół Ogólnokształcących w Bobowej

krechy1Pomysł napisania programu KRECHY zrodził się po lekturze stron internetowych dotyczących olimpiady informatycznej. Jedno z zadań konkursowych polegało na napisaniu programu komputerowego, który będzie szukał jak najlepszego wyniku w bardzo popularnej szkolnej grze, rozgrywanej na kratkowanym papierze. Postanowiłem napisać program, który ułatwi zabawę i być może pomoże w ustanowieniu nowego światowego rekordu. 40000 znaków w 1200 wierszach kodu źródłowego.

Gra przeznaczona jest dla jednego gracza i jej celem jest narysowanie jak największej ilości kresek o długości „pięciu kropek”. Gra toczy się na kartce z matematycznego zeszytu. Początkowy układ 36 kropek tworzy charakterystyczny krzyż. Gracz w każdym ruchu dorysowuje jedną kropkę tak, aby powstała linia pozioma, pionowa lub ukośna, która łączy dokładnie 5 kropek. Kreski mogą mieć wspólne końce, mogą się przecinać, ale nie mogą się nakładać.

krechy2 krechy3 krechy4

Program został napisany w najbardziej edukacyjnym języku programowania, jakim jest niewątpliwie Pascal i skompilowany również w bardzo popularnym programie Borland Delphi. Co program może: kropki ustawiamy myszką, kreski rysują się automatycznie, program podpowiada możliwe położenia nowych kropek, możemy zapisać na dysku gotowy układ.

Osobną funkcjonalnością jest prosty automat, który próbuje szukać nowych kresek. Kolejne wyszukiwane są dwoma sposobami: losowo lub rekurencyjnie – jeśli wyczerpią się wszystkie możliwości, usuwana jest poprzednia kreska i „zabawa” rozpoczyna się od nowa. poniżej fragment programu odpowiedzialny za wyszukiwanie:

procedure TForm1.Losowo(Sender:TObject);
var
  x,y,x1,y1,x2,y2:shortint;
  ByloKresek,kr,wynik,nr:integer;
begin
  Screen.Cursor:=crHourglass;
  ByloKresek:=IleKresek;        // zapamiętane żeby można było wrócić
  if IleMozliwych=0 then        // gdy od razu nie ma możliwości to wyjście
    KoniecRekurencji:=true;
  repeat                        // powtarzamy aż KoniecRekurencji
    while IleMozliwych > 0 do   // rysowanie gdy to możliwe
    begin
      nr:=random(IleMozliwych)+1;// wybieramy ruch losowo
      inc(LicznikRekurencji);    // ilość wykonanych ruchów
      Label12.Caption:=IntToStr(LicznikRekurencji);
      Label12.Repaint;
      WykonajRuch(Sender,Mozliwe[nr]);
      if IleKresek > RekordKresek then // gdy nowy rekord
      begin
        MaxRuchy:=Ruchy;               // rekordowe ruchy do tablicy pomocniczej
        RekordKresek:=IleKresek;       // ilość rekordowych kresek
        Label11.Caption:=IntToStr(RekordKresek);
        Label11.Repaint;
      end;
      if Rysuj then Image1.Repaint;    // przerysowanie
      if MaxKresek>0 then              // kiedy koniec
        if IleKresek>=MaxKresek then   // gdy są już kreski
          KoniecRekurencji:=true;
      if MaxRekurencji>0 then          // gdy za dużo ruchów
        if LicznikRekurencji > MaxRekurencji then
           KoniecRekurencji:=true;
    end; // było możłiwe ruchy
    if not(KoniecRekurencji) then // gdy skończyły się możliwości
      if IleMozliwych=0 then      // wycofać się do początku i od nowa
      begin
        kr:=IleKresek;            // zapamiętać na boku bo cofnij zmienia IleKresek
        For nr:=Kr downto ByloKresek+1 do // wycofaj wszystkie ruchy
          CofnijRuch(Sender,nr);
        IleKresek:=ByloKresek;    // kresek tyle ile na początku
        if Rysuj then Image1.Repaint;
      end;
  until KoniecRekurencji; // gdy koniec
end;

// rekurencyjnie szukamy
procedure TForm1.Rekurencja(Sender:TObject);
var
  NrP:integer; // Numer ruchu na danym poziomie
begin
 NrP:=1;       // na każdym poziomie rekurencji zaczynamy od pierwszego
 inc(LicznikRekurencji); // ile wykonało ruchów
 Label12.Caption:=IntToStr(LicznikRekurencji);
 Label12.Repaint;
 Repeat                       // główna pętla
  if NrP <=IleMozliwych then  // gdy są do badania możliwe na danym poziomie
  begin
    WykonajRuch(Sender,Mozliwe[NrP]); // wykonaj ruch
    if MaxKresek>0 then               // kiedy koniec
      if IleKresek>=MaxKresek then
        KoniecRekurencji:=true;
    if MaxRekurencji>0 then
      if LicznikRekurencji > MaxRekurencji then
        KoniecRekurencji:=true;
    if IleKresek > RekordKresek then  // gdy rekordowe ustawieni - informacja
    begin
      MaxRuchy:=Ruchy;
      RekordKresek:=IleKresek;
      Label11.Caption:=IntToStr(RekordKresek);
      Label11.Repaint;
    end;
    if rysuj then Image1.Repaint;     // przerysować
    inc(NrP);                         // gdy powróci z rekurencji będzie badać następny punkt
    if not(KoniecRekurencji) then     // gdy nie koniec to rekurencja
      Rekurencja(Sender);
    if not(koniecRekurencji) then     // wyszło z rekurencji - cofamy ruch
    begin
      CofnijRuch(Sender,IleKresek);
      if Rysuj then Image1.Repaint;
    end;
  end // nie ma możliwych ruchów na danym poziomie
  else exit;                          // gdy już nie ma do badania na poziomie
 until KoniecRekurencji;              // wychodzimy i wracamy na poprzedni poziom
end;

Kod źródłowy dla zainteresowanych TUTAJ

Program KRECHY - kilkanaście lat temu nazywałem go kropki.

Wacław Libront

Zobacz tutaj