Pasted

program project1;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this };
 
type
  Ttab=array[1..10] of integer;
 
var
  ldp,tn:char;  {L/R}
  tab:Ttab;
  i,wielkoscbazy:integer;
  wyjscie:boolean;  {przy wyjsciu shift ma zmienic na 1 jezeli nie bylo bledu}
 
procedure shift(var zmienna:char; var baza:Ttab; var liczba:integer);
var
  tymczas:Ttab;
begin
  {spr czy liczba jest w bazie jak nie wyjscie false}
  for i:=1 to 10 do
  begin
    if baza[i]=liczba then
    begin
       wyjscie:=true;
    end;
  end;
  {dzialanie}
  if wyjscie=true then
  begin
   {w prawo}
   if zmienna='P' then
   begin
    for i:=1 to liczba do
    begin
     tymczas[i+1]:=baza[i];
     if i=liczba then
        tymczas[1]:=tymczas[i+1];
    end;
 
   end;
   {w lewo}
   if zmienna='L' then
   begin
 
   for i:=liczba downto 1 do
   begin
    if i<>1 then
    tymczas[i-1]:=baza[i];
    if i=1 then
       tymczas[liczba]:=baza[1];
   end;
 
   end;
   baza:=tymczas;
  end;
end;
 
label
  start,kont,liczba;
 
begin
  wielkoscbazy:=5;
{zaladowanie bazy liczbami - nie powinny sie powtarzac}
  for i:=1 to wielkoscbazy do
  begin
    write('Podaj liczby do bazy ', i,'/',wielkoscbazy,' ');
    readln(tab[i]);
  end;
start:
{pytanie}
liczba:
  write('Wybierz tryb przesuniecia [L-lewo/P-prawo]: ');
  readln(ldp);
  if not ((ldp='L') or  (ldp='P')) then
  begin
       writeln('blad! podaj tylko L lub P');
       goto liczba;
  end;
{wykonanie}
  shift(ldp,tab,wielkoscbazy);
{wynik}
  if wyjscie=true then
  begin
  writeln('------Wynik-------');
  for i:=1 to wielkoscbazy do
  begin
    write(tab[i],' ');
  end;
  writeln();
  writeln('------------------');
  end
  else
  writeln('blad');
{czy ponowic/koniec}
kont:
  write('Czy chcesz kontynuowac? t/n');
  readln(tn);
  if ((tn='t') or (tn='T')) then
     goto start
  else
  halt;
end.