Uses Crt;

Const
  w1= 80;
  h1= 25;
  frq_g= 150;
  land= 1;
  ocean= 0;
  rock= 2;
  ice= 4;
  spec= 5;
  frq_2= 3;

type
  tmap= array [1..w1, 1..h1] of integer;

var
  map: tmap;
  temp_w, temp_h, temp_r, t_wx, t_wy: integer;
  test1_x, test1_y, test2, test3, test4, test5: integer;
  f: text;
  result1: string;

function minus(c: integer): integer;
begin
  if c-1<0 then minus:=c
  else
  if c-1<0 then minus:=c
  else
  if c-1=0 then minus:=c
  else
  if c-1=0 then minus:=c
  else
minus:= c-1;
end;

function plus_w(c: integer): integer;
begin
  if c+1>w1 then plus_w:=c
  else
plus_w:=c+1;
end;

function plus_h(c: integer): integer;
begin
  if c+1>h1 then plus_h:=c
  else
plus_h:=c+1;
end;

procedure arr_over_test;
begin
  if test1_x>w1 then test1_x:=temp_w
  else
  if test1_y>h1 then test1_y:=temp_h
  else
  if test1_x<0 then test1_x:=temp_w
  else
  if test1_y<0 then test1_y:=temp_h
  else
  if test1_x=0 then test1_x:=temp_w
  else
  if test1_y=0 then test1_y:=temp_h
  else
end;

procedure spec_gen;
begin
  test5:=frq_2;
  arr_over_test;
  test5:=test5-1;
  if Random(test5)= 2 then
  begin
    map[test1_x, test1_y]:=spec;
  end
  else
  map[test1_x, test1_y]:=land
end;

procedure continent;
begin
  map[temp_w, temp_h]:=rock;
  t_wx:= wherex;
  t_wy:= wherey;

  // вверх-вниз V

  test1_x:= temp_w;
  test1_y:= temp_h+1;
  arr_over_test;
  spec_gen;

  test1_x:= temp_w;
  test1_y:= temp_h-1;
  arr_over_test;
  spec_gen;

  test1_x:= temp_w+1;
  test1_y:= temp_h;
  arr_over_test;
  spec_gen;

  test1_x:= temp_w-1;
  test1_y:= temp_h;
  arr_over_test;
  spec_gen;

  // диагональ V

  test1_x:= temp_w+1;
  test1_y:= temp_h+1;
  arr_over_test;
  spec_gen;

  test1_x:= temp_w-1;
  test1_y:= temp_h+1;
  arr_over_test;
  spec_gen;

  test1_x:= temp_w+1;
  test1_y:= temp_h-1;
  arr_over_test;
  spec_gen;

  test1_x:= temp_w-1;
  test1_y:= temp_h-1;
  arr_over_test;
  spec_gen;

end;

procedure delisl;
begin
test3:=0;
if map[plus_w(temp_w), temp_h]= ocean then test3:=test3+1
else
if map[minus(temp_w), temp_h]= ocean then test3:=test3+1
else
if map[temp_w, plus_h(temp_h)]= ocean then test3:=test3+1
else
if map[temp_w, minus(temp_h)]= ocean then test3:=test3+1;
if test3>=3 then map[temp_w, temp_h]:=ocean
else
end;

begin
ClrScr;
randomize();


for temp_r:= 1 to frq_g do
map[Random(79)+1, Random(24)+1]:=spec;

for temp_w:= 1 to w1 do
for temp_h:= 1 to h1 do
begin
  begin
      if map[temp_w, temp_h]= spec then continent
      else
  end;
  if Random(3)=1 then test4:=2
  else test4:=1;
  if Random(5)=1 then
  map[temp_w, temp_h]:= Random(test4)
  else
end;

for temp_w:= 1 to w1 do
for temp_h:= 1 to h1 do
begin
if map[temp_w, temp_h]=land then delisl
else
end;

for temp_w:= 1 to 10 do
for temp_h:= 1 to h1 do
begin
if map[temp_w, temp_h]=land then map[temp_w, temp_h]:=ice
else
if map[temp_w, temp_h]=rock then map[temp_w, temp_h]:=ice
else
end;

for temp_w:= 75 to w1 do
for temp_h:= 1 to h1 do
begin
if map[temp_w, temp_h]=land then map[temp_w, temp_h]:=ice
else
if map[temp_w, temp_h]=rock then map[temp_w, temp_h]:=ice
else
end;

Assign(f, 'D:\SAVEDMAP.txt');
rewrite(f);
for temp_h:= 1 to h1 do
begin
writeln(f, '');
for temp_w:= 1 to w1 do
begin
  str(map[temp_w, temp_h], result1);
  write(f, result1);
end;
end;

for temp_w:= 1 to w1 do map[temp_w, 1]:=ice;

for temp_w:= 1 to 80 do
for temp_h:= 1 to h1 do
  begin
      if map[temp_w, temp_h]= land then textcolor(2)
      else
      if map[temp_w, temp_h]= ocean then textcolor(1)
      else
      if map[temp_w, temp_h]= rock then textcolor(6)
      else
      if map[temp_w, temp_h]= ice then textcolor(15);
      write('█');
  end;
Readln;
end.