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.