Марио

program mario1;
uses crt,graph;
var x,y,i,j,n,m:integer;
    k:char; map:text;
    a:array[1..100,1..100] of integer;
procedure GraphInterFace;
Var driver, mode, error:Integer;
    s: String;
begin
     driver:=detect; s:='';
     InitGraph(driver,mode,s);
end;
procedure ylet;
begin
assign(map,'map.txt');
reset(map);
for i:=1 to 5 do
begin
 for j:=1 to 8 do
 readln(map,a[i,j]);
 if a[i,j]=1 then
  circle(20,20,30);
  end;
end;
procedure pole;
begin
setcolor(white);
rectangle(0,400,640,480);
rectangle(250,300,350,325);
rectangle(450,300,490,400);
end;
Procedure mario (var a:integer;b:integer);
begin
     SetBkColor(11);
     SetColor(5);
     circle(30+a,60+b,20);
end;
begin
  clrscr;
  GraphInterFace;
  x:=20;
  y:=320;
     While true do
     begin
     pole ;
     mario(x,y);
           k:=#0;
          while (k<>#77) and (k<>#75) and (k<>#72) and (k<>#80) do
          begin
          k:=readkey;
          end;
          Cleardevice;
           Case k of
                #77:begin x:=x+10;  end;
                #75:begin x:=x-10;   end;
         end;end;end.

uses
  crt;
 
const
  x = 23;
 
var
  a: array [1..x, 1..x] of char;
  i, j: integer;
  c: char;
  b: boolean;
  k: byte;
 
procedure swap(var a, b: integer);
var
  temp: integer;
begin
  temp := a;
  a := b;
  b := temp;
end;
 
begin
  begin
    for i := 1 to x do
    begin
      a[i, 1] := '#';
      a[i, x] := a[i, 1];
      a[1, i] := '#';
      a[x, i] := a[1, i];
    end;
    for i := 2 to x - 1 do
      for j := 2 to x - 1 do
        a[i, j] := ' ';
    a[x div 2 + 1, x div 2 + 1] := #1;
  end;
  repeat
    repeat
      clrscr;
      Writeln('Нажимайте ', #27, #26, ' для перемещения по диагонали и ', #25, #24, ' для перемещения по вертикали');
      k := 0;
      for i := 1 to x do
      begin
        begin
          for j := 1 to x do
            write(A[i, j], ' ');
        end;
        writeln;
      end;
      c := readkey;
      if c = #0 then b := true;
      if b then c := readkey;
      case c of
        #37:  
          begin
            for i := 2 to x - 1 do
            begin
              for j := 2 to x - 2 do
                swap(a[i, j], a[i, j + 1]);
            end;
          end;
        #39:  
          begin
            for i := 2 to x - 1 do
            begin
              for j := x - 2 downto 2 do
                swap(a[i, j], a[i, j + 1]);
            end;
          end;
        #38:
          begin
            for j := 2 to x - 1 do
            begin
              for i := 2 to x - 2 do
                swap(a[i, j], a[i + 1, j]);
            end;
          end;
        #40:
          begin
            for j := 2 to x - 1 do
            begin
              for i := x - 2 downto 2 do
                swap(a[i, j], a[i + 1, j]);
            end;
          end;
      else
        break;  
      end;
    until k = 0;
  until c = #27;
end.