program rechtpunktlesen;
uses Graph, crt;

type farbtyp = array[1..2250] of 0..15;

var Gd, Gm, x, y, i, j, d : Integer;
    farbe : farbtyp;
    felfeld : array[1..3] of pointtype;
    datei : file of farbtyp;

procedure tast;

  var ch : char;
  begin
    ch:=readkey;
    repeat
    until keypressed;
  end;

procedure rechteck(x1, y1, x2, y2: integer);

  var ind : word;

  begin
    ind:=1;
    for i:=x1+1 to x2-1 do farbe[ind+i-x1-1]:=getpixel(i, y1);
    ind:=ind+x2-x1-1;
    for i:=x1+1 to x2-1 do farbe[ind+i-x1-1]:=getpixel(i, y2);
    ind:=ind+x2-x1-1;
    for i:=y1 to y2 do farbe[ind+i-y1]:=getpixel(x1, i);
    ind:=ind+y2-y1+1;
    for i:=y1 to y2 do farbe[ind+i-y1]:=getpixel(x2, i);

    for i:=x1+1 to x2-1 do putpixel(i, y1, 0);
    for i:=x1+1 to x2-1 do putpixel(i, y2, 0);
    for i:=y1 to y2 do putpixel(x1, i, 0);
    for i:=y1 to y2 do putpixel(x2, i, 0);
  end;

procedure linie(x1, y1, x2, y2: integer);

  var ind : word;

  begin
    ind:=1;
    for i:=y1 to y2 do farbe[ind+i-y1]:=getpixel(x1, i);
    ind:=ind+y2-y1+1;
    for i:=y1 to y2 do farbe[ind+i-y1]:=getpixel(x2, i);

    for i:=y1 to y2 do putpixel(x1, i, 0);
    for i:=y1 to y2 do putpixel(x2, i, 0);
  end;

procedure lesen;
  begin
    x:=0;
    d:=0;
    assign(datei, 'd:\tp\tunnel.ppi');
    rewrite(datei);
    for j:=1 to 320 do
      begin
        if j mod 4 <> 1 then d:=d+1;
        if j mod 4 <> 1
          then rechteck(320-j, 240-d, 320+j-1, 240+d)
          else linie(320-j, 240-d, 320+j-1, 240+d);
        write(datei, farbe);
        if keypressed then readln;
      end;
    close(datei);
  end;

{----------------------------------------------------------------------------}

procedure wolkenzeich;

  var xr, yr : byte;
      xp, yp : 0..640;
      farbe, j : word;
      wink   : real;

  begin
    setcolor(15);
    setfillstyle(1, 15);
    xr:=random(130);
    repeat
       yr:=6+random(xr div 2);
    until yr=yr;
    xp:=random(639); yp:=random(100);
    fillellipse(xp, yp, xr-4, yr-4);
    for j:=1 to 360 do
      begin
        setcolor(15);
        if random(2)=4 then ellipse(xp, yp, j-1, j, xr-4, yr-4);
        if random(5)=4 then ellipse(xp, yp, j-1, j, xr-3, yr-3);
        if random(8)=4 then ellipse(xp, yp, j-1, j, xr-2, yr-2);
        if random(11)=4 then ellipse(xp, yp, j-1, j, xr-1, yr-1);
        if random(14)=4 then ellipse(xp, yp, j-1, j, xr, yr);
      end;
    if (random(2)=1) and (xr-15>0) and (yr-20>0) then else exit;
    setcolor(7);
    setfillstyle(1, 7);
    fillellipse(xp, yp+8, xr-15, yr-20);
    for j:=1 to 360 do
      begin
        setcolor(7);
        if random(2)=4 then ellipse(xp, yp+8, j-1, j, xr-15, yr-20);
        if random(5)=4 then ellipse(xp, yp+8, j-1, j, xr-14, yr-19);
        if random(8)=4 then ellipse(xp, yp+8, j-1, j, xr-13, yr-18);
        if random(11)=4 then ellipse(xp, yp+8, j-1, j, xr-12, yr-17);
        if random(14)=4 then ellipse(xp, yp+8, j-1, j, xr-11, yr-16);
      end;
  end;

procedure bild;
  begin
    setcolor(11); setfillstyle(1, 11); {Himmel}
    bar(0, 0, 639, 200);
    setcolor(7);
    felfeld[1].x:=82;             {Straáe}
    felfeld[1].y:=479;
    felfeld[2].x:=320;
    felfeld[2].y:=240;
    felfeld[3].x:=560;
    felfeld[3].y:=479;
    setfillstyle(1, lightgray);
    fillpoly(3, felfeld);
    setcolor(white);
    setlinestyle(3, 10, 3);
    line(320, 479, 320, 235);
    setcolor(darkgray);          {Felsen rechts}
    setlinestyle(0, 0, 0);
    setfillstyle(1, darkgray);
    line(310, 170, 320, 240);
    line(320, 240, 561, 479);
    line(561, 479, 639, 479);
    line(639, 479, 639, 200);
    line(639, 200, 310, 170);
    {floodfill(560, 400, darkgray);}
    for i:=1 to 10 do wolkenzeich;     {Wolken}
    setcolor(8);                      {Felsen links}
    line(0, 200, 0, 479);
    line(0, 479, 81, 479);
    line(41, 479, 280, 240);
    line(280, 240, 290, 170);
    line(290, 170, 0, 200);
    setfillstyle(1, 8);
    floodfill(80, 300, 8);
    setcolor(2);                   {Tal}
    line(21, 479, 280, 230);
    line(280, 230, 290, 170);
    line(290, 170, 310, 170);
    line(310, 170, 320, 240);
    line(320, 240, 81, 479);
    line(81, 479, 41, 479);
    setfillstyle(1, 2);
    floodfill(51, 475, 2);
    setlinestyle(0, 0, 3);
    setcolor(9);             {Fluá}
    line(51, 479, 295, 240);
    line(295, 240, 300, 170);
    setcolor(8);                    {Straáenbegrenzung links}
    line(81, 479, 320, 240);
    setfillstyle(1, 8);             {Tunnelportal}
    setlinestyle(0, 0, 0);
    line(310, 250, 310, 170);
    floodfill(311, 239, 8);
    setcolor(0);
    setfillstyle(1, 0);
    bar(315, 245, 325, 235);
  end;

begin
  randomize;
  for i:=1 to 1000 do
    begin
      farbe[i]:=random(13)+2;
    end;
  Gd := Detect; InitGraph(Gd, Gm, 'd:\tp\bgi');
  bild;
  lesen;
  readln;
  closegraph;
end.