program hello;
{Egyszeru Pascal program, ami kiirja, hogy 'Hello World!'
 Keszitett: jasy
            2004.09.25 }
begin
  writeln('Hello World!');
end.

****************************
program szambekero_1;
{Egyszeru Pascal program, ami beker 3 egesz szamot, es kiirja azokat a kepernyore.
 Keszitett: jasy
            2004.09.25 }
var szam1, szam2, szam3: integer;
begin
  writeln('Irjon be 3 szamot: '); 
  readln (szam1, szam2, szam3);
  writeln ('Az elso szam: ', szam1);
  writeln ('Az masodik szam: ', szam2);
  writeln ('Az harmadik szam: ', szam3);
end.

****************************
program szambekero_2;
{Egyszeru Pascal program, ami kiir 3 konstanst a megfelelo helyiertekeket 
  egymas ala rendezve.
 Keszitett: jasy
            2004.09.25 }
begin
  writeln (1234:6);
  writeln (123456:6);
  writeln (-5:6);
end.

****************************
program szambekero_3;
{Egyszeru Pascal program, ami valos szamokat olvas be es ir ki
 Keszitett: jasy
            2004.09.25 }
var a, b, c: real;
begin
  writeln ('Adjon meg harom valos szamot: ');
  readln (a, b, c);
  writeln ('Az elso:' ,a);
  writeln  ('A masodik:', b:5);
  writeln ('A harmadik:', c:5:3);
 end.

****************************
program beepitett_konstansok;
{Egyszeru Pascal program, ami kiirja az egyes integer tipusok legnagyobb lehetseges ertekeit
 Keszitett: jasy
            2004.09.25 }
begin
  writeln ('A legnagyobb integer: ', MAXINT);
  writeln ('A legnagyobb longint: ', MAXLONGINT);
end.

****************************
program szambekero;
{Egyszeru Pascal program, ami beker 3 szamot, eldonti, hogyy ilyen oldalhosszakkal
 letezhet e haromszog, es ha igen, akkor kiszamolja annak teruletet es keruletet.
 Keszitett: jasy
            2004.09.25 }
var a, b, c, s: real;
begin
  writeln ('Adjon meg harom szamot: ');
  readln (a, b, c);
  if ((a > c+b) or (b > a+c) or (c >a+b)) then begin
    writeln ('A megadott adatok nem lehetnek egy haromszog oldalai');
  end else begin
    s := a+b+c;
    writeln('Kerulet: ', a+b+c:5:0);
    s := s/2;
    writeln ('Terulet: ', sqrt (s*(s-a)*(s-b)*(s-c)):5:0);
  end;	   
end.

****************************
program paritas;
{Egyszeru Pascal program, ami beolvas egy szamot, majd eldonti annak paritasat.
 Keszitett: jasy
            2004.09.25 }
var a:integer;
begin
  write ('A szam: ');
  readln (a);
  if Odd (a) then writeln ('Paratlan')
  else writeln ('Paros');
end.

****************************
program elojel;
{Egyszeru Pascal program, ami beolvas egy szamot, majd eldonti annak elojelet.
 Keszitett: jasy
            2004.09.25 }
var a:integer;
begin
  write ('A szam: ');
  readln (a);
  if a < 0 then writeln ('Negativ')
  else if a = 0 then writeln ('Nulla')
  else writeln('Pozitiv');
end.

****************************
program sakk;
{Input: sakktabla egy mezojenek koordinatai.
 Output: a mezo szine, es az, hogy eredetileg milyen babu all rajta.
 Keszitett: jasy
            2004.09.25 }
var  oszlop: integer;
        sor: char;
begin
  write ('A mezo koordinatai: ');
  readln (sor, oszlop);
  if Odd (oszlop)  then 
    case sor of
      'a', 'c', 'e', 'g': writeln ('Feher');
      'b', 'd', 'f', 'h': writeln ('Fekete');
    end
  else 
    case sor of 
     'a', 'c', 'e', 'g': writeln ('Fekete');
      else writeln ('Feher');
    end; 
   
  case sor of
    'a', 'h': 
        case oszlop of
           1, 8: writeln ('Bastya');
           2, 7: writeln ('Vezer');
           3, 6: writeln ('Futo');
           4: if sor='a' then  writeln ('Kiralyno')
                         else  writeln ('Kiraly');
           else if sor='a' then writeln ('Kiraly')
                           else writeln ('Kiralyno');
           end;
     'b', 'g': writeln ('Paraszt');
      else writeln ('Nincs');
      end;
end.

****************************
program prim_1;
{Pascal program, amely meghatarozza az elso 500 primet.
	Keszitett: jasy
            2004.09.25 }
var i, j, oszto: integer;
begin
  for i:= 1 to 500 do begin
    oszto := 0;
    for j:= 2 to round (sqrt (i)) do  
       if (i mod j) = 0 then inc(oszto);
    if (oszto = 0) then write (i, ' ' );
  end;
end.

****************************
program prim_2;
{Pascal program, amely meghatarozza az elso 255 primet.
 Keszitett: jasy
            2004.09.25 }
const max = 255;
type
  szamhalmaz = set of 1..max;
var n, kovprim, i : integer;
    szamh, primh: szamhalmaz;
begin
  szamh := [2..max];
  primh := [];
  kovprim := 2;
  while szamh <> [] do begin
    n := kovprim;
    while n <= max do begin
      szamh := szamh - [n];
      n := n+kovprim;
    end;  
    primh := primh + [kovprim];
    repeat
      inc(kovprim);
    until (kovprim in szamh) or (kovprim = max);
  end;
  for i:= 1 to max do
    if i in primh then write(i:4);
end.

****************************
program jatek;
(*  Jatek! Feladat a gep altal kigondolt 100-nal nem nagyobb természetes szam kitalalasa.
    Keszitette:  jasy 
	         2004. 10. 10 *)
var szam, tipp : integer;
begin
  randomize;
  szam := random (101);
  while (TRUE) do begin
    write ('Kerem a tippet! ');
    readln (tipp);
    if tipp = szam then begin 
      writeln ('Eltalaltad!');
      break;
    end;
  if tipp > szam then writeln ('A tipp tul nagy!')
  else writeln ('A tipp tul kicsi! ');
 end;
end.

****************************
program palindrom;
(*  Feladat egy bekert szamrol eldonteni, hogy palindrom e. (Azaz barmely iranybol olvasva ugyanazt a szamot hatarozza meg.)
    Keszitette:  jasy 
                 2004. 10. 10 *)
function szamjegyek_szama (szam : longint): longint;
begin
  szamjegyek_szama := 1;
  while szam > 9 do begin
   szam := szam div 10;
   inc (szamjegyek_szama);
  end; 
end;
	
function ndik (szam, n: longint): longint;
var oszto, i : longint;
begin
  oszto := 1;
  for i:= 1 to szamjegyek_szama (szam) - n do 
    oszto := oszto*10;
  szam:= szam mod (oszto*10);
  ndik := szam div oszto
end;
	
var szam , m, i, j: longint; 
begin
  write ('Kerem adja meg a szamot: '); 
  readln (szam);
  m := szamjegyek_szama (szam);
  i := 1;
  while (TRUE) do begin
    j := m - i +1;
    if ndik(szam, i) <> ndik (szam, j) then begin
    writeln ('A ', szam, ' nem palindrom szam.');
    break;
  end;
  if (i+1 ) >= j then begin
    writeln ('A ', szam, ' egy palindrom szam.');
    break;
  end;
  inc (i);
  end;
end.

****************************
program string_kezeles;
{Program fuggvenyek hasznalatanak szemleltetesere. Illetve stringek kezelesere.
   Keszitette: jasy - 2004. 10.16}
   
var main_str, temp: string;
    i : integer;
    
function str_konverter_1(var str: string) : integer;
var j:integer;
begin
  str_konverter_1 := 0;
  for j := 1 to length(str) do begin
    inc (str_konverter_1);
    str[j] := upcase (str[j]);
  end;
  writeln ('A string erteke a fuggvenyben: ',  str);
end;
	
function str_konverter_2(str: string) : integer;
var j:integer;
begin
  str_konverter_2 := 0;
  for j := 1 to length(str) do begin
    inc (str_konverter_2);
    str[j] := upcase (str[j]);
  end;
  writeln ('A string erteke a fuggvenyben: ',  str);
end;

procedure kiiro (i: integer; str: string);
begin
  writeln (i, ' az i erteke');
  writeln (str, ' a string erteke');
  writeln;
end;

begin
  writeln ('Kerem irjon be egy stringet!');
  readln (main_str);
  temp:= main_str;
  i :=  str_konverter_1 (main_str);
  writeln ('A kiiro eljaras elso meghivasa a fo programtorzsbol.');
  kiiro (i, main_str);

  main_str := temp;
  i :=  str_konverter_2 (main_str);
  writeln ('A kiiro eljaras masodik meghivasa a fo programtorzsbol.');
  kiiro (i, main_str);
end.

****************************
program fib;
{Rekurziv program - Fibonacci sorozat n-dik elemenek meghatarozasa.
   Keszitette: jasy - 2004. 10.16}
   
var szam : longint;
function fib_rekurziv (i: longint) :longint;
begin
  if i <= 1 then fib_rekurziv := 1
  else fib_rekurziv := fib_rekurziv (i-1) + fib_rekurziv (i-2);
end;

begin
  writeln ('Kerem adjon meg egy szamot!');
  readln(szam);
  szam := fib_rekurziv (szam);
  writeln ('Az n. szam a sorozatban: ', szam);
end.

****************************
program tipusok;
{Program tipus  letrehozasara, halmaz es tomb hasznalatara.
   Keszitette: jasy - 2004. 10.16}
   
type  napok = (hetfo, kedd, szerda, csutortok, pentek, szombat, vasarnap);
var hetkoznap, hetvege: set of napok; 
       i: napok;
       nap_nev : array [hetfo..vasarnap] of string = ('Hetfo', 'Kedd', 'Szerda', 'Csutortok', 'Pentek', 'Szombat', 'Vasarnap');
begin
  hetkoznap := []; 
  hetvege := [];
   for i := hetfo to vasarnap do begin
     if (i = vasarnap) or (i= szombat) then hetvege := hetvege + [i]
     else hetkoznap := hetkoznap +  [i];
   end;
   
   writeln ('Hetkoznapok');
   for i:= hetfo to vasarnap do 
     if i in hetkoznap then writeln (nap_nev[i]);   

     writeln;		  
     writeln ('Hetvegi napok');
     for i:= hetfo to vasarnap do 
     if i in hetvege then writeln(nap_nev[i]);   
end.

****************************
program beolvas_kiir;
{Program, amely rekord típust definial, tombot hasznal es file-bol olvas, file-bol ir.
 Keszitette: jasy - 2004. 10.22.
}

{-----------------------------------------------}
{intervallum egy altalunk definialt rekord tipus}
{-----------------------------------------------}
type intervallum = record 
  bal_veg, jobb_veg : integer;
  bzart, jzart : char;
end;

{--- --------------------------------------}
{tomb egy altalunk definialt array tipus,  }
{melynek elemei intervallum tipusu valtozok}
{-   --------------------------------------}
type tomb = array[1..10] of intervallum;
	
{------------------------}
{File-bol olvaso fuggveny}
{------------------------}
function beolvas (var rekordok: tomb; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
  t : char;
begin
   Assign (file_valtozo, nev);
   reset (file_valtozo);
   beolvas := ioresult = 0;
   if beolvas then begin 
      readln (file_valtozo, mennyi);
      for i:= 1 to mennyi do 
        readln(file_valtozo, rekordok[i].bal_veg, rekordok[i].jobb_veg, t, rekordok[i].bzart, t, rekordok[i].jzart);
   end;
   close (file_valtozo);
end;

{------------------------}
{File-ba iro fuggveny.   }
{------------------------}	  
function kiir (var rekordok: tomb; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
begin
   Assign (file_valtozo, nev);
   rewrite(file_valtozo);
   kiir := ioresult = 0;
   if kiir then begin 
      for i:= 1 to mennyi do begin
        if rekordok[i].bzart = 'T' then write (file_valtozo, '[') else  write (file_valtozo, ']') ;
        write(file_valtozo, rekordok[i].bal_veg, ',' , rekordok[i].jobb_veg);
        if rekordok[i].jzart = 'T'  then write (file_valtozo, ']') else  write (file_valtozo, '[') ;
        writeln (file_valtozo);
      end;
   end;
   close (file_valtozo);
end;

var rekord_tomb : tomb;
  szam : integer;
	  
begin
   beolvas (rekord_tomb, 'be.txt', szam);
   kiir (rekord_tomb, 'ki.txt', szam);
end.

****************************
program dinamikus;
{Program dinamikus mem+-riafoglal+ís szeml+êltet+ês+êre.
 Keszitette: jasy - 2004. 10.22.
}

{-----------------------------------------------}
{intervallum egy altalunk definialt rekord tipus}
{-----------------------------------------------}
type intervallum = record 
  bal_veg, jobb_veg : integer;
  bzart, jzart : char;
end;

{--- --------------------------------------}
{tomb egy altalunk definialt array tipus,  }
{melynek elemei intervallum tipusu valtozok}
{tomb_ptr egy tomb-re mutato pointer.      }
{------------------------------------------}
type tomb = array[1..10000] of intervallum;
         tomb_ptr = ^tomb;
{------------------------}
{Meret lekerdezese.      }
{------------------------}
function meret (nev :string):integer;
var file_valtozo : text;
begin
   Assign (file_valtozo, nev);
   reset (file_valtozo);
   meret := 0; ;
   if ioresult = 0 then 
      readln (file_valtozo, meret);
   close (file_valtozo);
end;

{------------------------}
{File-bol olvaso fuggveny}
{------------------------}
function beolvas (var rekordok: tomb_ptr; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
  t : char;
begin
   Assign (file_valtozo, nev);
   reset (file_valtozo);
   beolvas := ioresult = 0;
   if beolvas then begin 
      readln (file_valtozo, mennyi);
      for i:= 1 to mennyi do 
        readln(file_valtozo, rekordok^[i].bal_veg, rekordok^[i].jobb_veg, t, rekordok^[i].bzart, t, rekordok^[i].jzart);
   end;
   close (file_valtozo);
end;

{------------------------}
{File-ba iro fuggveny.   }
{------------------------}	  
function kiir (var rekordok: tomb_ptr; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
begin
   Assign (file_valtozo, nev);
   rewrite(file_valtozo);
   kiir := ioresult = 0;
   if kiir then begin 
      for i:= 1 to mennyi do begin
        if rekordok^[i].bzart = 'T' then write (file_valtozo, '[') else  write (file_valtozo, ']') ;
        write(file_valtozo, rekordok^[i].bal_veg, ',' , rekordok^[i].jobb_veg);
        if rekordok^[i].jzart = 'T'  then write (file_valtozo, ']') else  write (file_valtozo, '[') ;
        writeln (file_valtozo);
      end;
   end;
   close (file_valtozo);
end;
		   
var rekord_tomb : tomb_ptr;
  szam : integer;
	  
begin
   szam := meret ('be.txt');
   getmem (rekord_tomb ,sizeof(intervallum)*szam);
   beolvas (rekord_tomb, 'be.txt', szam);
   kiir (rekord_tomb, 'ki.txt', szam);
   freemem (rekord_tomb, sizeof(intervallum)*szam);
end.
****************************
program rendezes;
{Program, amely tombben tarolt rekordokat rendez buborek rendezessel. 
 Keszitette: jasy - 2004. 10.22.
}

{-----------------------------------------------}
{intervallum egy altalunk definialt rekord tipus}
{-----------------------------------------------}
type intervallum = record 
  bal_veg, jobb_veg : integer;
  bzart, jzart : char;
end;

{--- --------------------------------------}
{tomb egy altalunk definialt array tipus,  }
{melynek elemei intervallum tipusu valtozok}
{------------------------------------------}
type tomb = array[1..10] of intervallum;

{------------------}
{rendezesi relacio }
{------------------}
function kisebb (var rekordok: tomb; i, j: integer): boolean;
begin
  kisebb := false;
  if rekordok[i].bal_veg < rekordok[j].bal_veg then kisebb := true;
  if (rekordok[i].bal_veg = rekordok[j].bal_veg) and ((rekordok[i].bzart = rekordok[j].bzart) or (rekordok[i].bzart ='T' )) then kisebb:=true;
end;
   
procedure buborek (var rekordok : tomb; meret : integer);
var i, j : integer;
   t : intervallum;
begin
  for i := 1 to meret - 1 do
    for j:= 1 to meret-i do
      if not kisebb (rekordok, j, j+1) then begin 
        t := rekordok[j];
        rekordok[j] := rekordok[j+1];
        rekordok[j+1] := t;
      end;
end;

{------------------------}
{File-bol olvaso fuggveny}
{------------------------}
function beolvas (var rekordok: tomb; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
  t : char;
begin
   Assign (file_valtozo, nev);
   reset (file_valtozo);
   beolvas := ioresult = 0;
   if beolvas then begin 
      readln (file_valtozo, mennyi);
      for i:= 1 to mennyi do 
        readln(file_valtozo, rekordok[i].bal_veg, rekordok[i].jobb_veg, t, rekordok[i].bzart, t, rekordok[i].jzart);
   end;
   close (file_valtozo);
end;

{------------------------}
{File-ba iro fuggveny.   }
{------------------------}	  
function kiir (var rekordok: tomb; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
begin
   Assign (file_valtozo, nev);
   rewrite(file_valtozo);
   kiir := ioresult = 0;
   if kiir then begin 
      for i:= 1 to mennyi do begin
        if rekordok[i].bzart = 'T' then write (file_valtozo, '[') else  write (file_valtozo, ']') ;
        write(file_valtozo, rekordok[i].bal_veg, ',' , rekordok[i].jobb_veg);
        if rekordok[i].jzart = 'T'  then write (file_valtozo, ']') else  write (file_valtozo, '[') ;
        writeln (file_valtozo);
      end;
   end;
   close (file_valtozo);
end;

var rekord_tomb : tomb;
  szam : integer;
	  
begin
   beolvas (rekord_tomb, 'be.txt', szam);
   buborek (rekord_tomb, szam);
   kiir (rekord_tomb, 'ki.txt', szam);
end.
****************************

program fv_parameter;
{Program, amely tombben tarolt rekordokat rendez buborek rendezessel. 
 A rendezesi relacio fuggvenyet fuggveny parameterkent adjuk at.
 Keszitette: jasy - 2004. 10.22.
}
uses crt;
type intervallum = record 
  bal_veg, jobb_veg : integer;
  bzart, jzart : char;
end;
type tomb = array[1..10] of intervallum;

{---------------------------}
{Fuggveny tipus deklaralasa }
{---------------------------}
type fugg = function(var x:tomb; i, j:integer):boolean;

{-------------------}
{rendezesi relaciok }
{-------------------}
function kisebb_bal_vegpont_alapjan (var rekordok: tomb; i, j: integer): boolean;
begin
  kisebb_bal_vegpont_alapjan := false;
  if rekordok[i].bal_veg < rekordok[j].bal_veg then kisebb_bal_vegpont_alapjan := true;
  if (rekordok[i].bal_veg = rekordok[j].bal_veg) and ((rekordok[i].bzart = rekordok[j].bzart) or (rekordok[i].bzart ='T' )) 
    then kisebb_bal_vegpont_alapjan:=true;
end;
	  
function kisebb_kozepertek_alapjan (var rekordok: tomb; i, j: integer): boolean;
begin
  kisebb_kozepertek_alapjan := false;
  if (rekordok[i].jobb_veg - rekordok[i].bal_veg) div 2 <= (rekordok[j].jobb_veg - rekordok[j].bal_veg) div 2 
   then kisebb_kozepertek_alapjan := true;
  end;
	  
{----------------------------------------------}
{rendezes, ami hasznalja a fuggveny parametert }
{----------------------------------------------}
procedure buborek (var rekordok : tomb; meret : integer; fv : fugg);
var i, j : integer;
   t : intervallum;
begin
  for i := 1 to meret - 1 do
    for j:= 1 to meret-i do
     if not fv (rekordok, j, j+1) then begin 
       t := rekordok[j];
       rekordok[j] := rekordok[j+1];
       rekordok[j+1] := t;
     end;
end;
		  
function beolvas (var rekordok: tomb; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
  t : char;
begin
   Assign (file_valtozo, nev);
   reset (file_valtozo);
   beolvas := ioresult = 0;
   if beolvas then begin 
      readln (file_valtozo, mennyi);
      for i:= 1 to mennyi do 
        readln(file_valtozo, rekordok[i].bal_veg, rekordok[i].jobb_veg, t, rekordok[i].bzart, t, rekordok[i].jzart);
   end;
   close (file_valtozo);
end;
	  
function kiir (var rekordok: tomb; nev :string; var mennyi: integer):boolean;
var file_valtozo : text;
  i : integer;
begin
   Assign (file_valtozo, nev);
   rewrite(file_valtozo);
   kiir := ioresult = 0;
   if kiir then begin 
      for i:= 1 to mennyi do begin
        if rekordok[i].bzart = 'T' then write (file_valtozo, '[') else  write (file_valtozo, ']') ;
        write(file_valtozo, rekordok[i].bal_veg, ',' , rekordok[i].jobb_veg);
        if rekordok[i].jzart = 'T'  then write (file_valtozo, ']') else  write (file_valtozo, '[') ;
        writeln (file_valtozo);
      end;
   end;
   close (file_valtozo);
end;

var rekord_tomb : tomb;
  szam : integer;
  valasztas : integer;  
  ch : char;
begin
   beolvas (rekord_tomb, 'be.txt', szam);
   
    writeln('Valasszon rendezesi modot!');
    writeln ('1. Rendezes bal vegpont alapjan');
    writeln('2. Rendezes az intervallum kozeperteke szerint');
    repeat 
      ch := readkey;
   until (ch='1') or (ch='2');
   
    case ch of
      '1' :  buborek (rekord_tomb, szam, @kisebb_bal_vegpont_alapjan );
      '2' :  buborek (rekord_tomb, szam, @kisebb_kozepertek_alapjan );
    end;
    kiir (rekord_tomb, 'ki.txt', szam);
end.