program vogeltrickfilm;
{Name: Stefan Ziegler}
uses graph, crt;

const vogelfuellmuster : fillpatterntype =
                           (221, 34, 221, 34, 221, 34, 221, 34);

var i, a, b, c, zahl, anz, rananz      : integer; {allgemeine Variablen}
    graphdriver, graphmode             : integer; {Graphikvariablen}
    z, z1, z3, yv, yj                  : integer; {Variablen fr V”gel}
    durchlauf                          : 0..10;   {allg. Variablen}
    anzz                               : 0..4;
    himmel, wasser, weiss, sonne       : word;  {Variablen fr die Fabren}
    holz, felsen, wiese, weg, hellgrau : word;
    strahlen                           : word;
    vogfar1, vogfar2, vogfar3, vogfar4 : word;{Variablen fr Farben der V”gel}
    quarz                              : fillpatterntype; {Fllmustervar.}
    felseny                            : array [1..640] of integer;

{****************************************************************************}

procedure farben;
  begin
    himmel:=11; wasser:=1; weiss:=15; sonne:=62; holz:=60; felsen:=56;
    wiese:=2; weg:=4; hellgrau:=7; strahlen:=61;
    vogfar1:=3; vogfar2:=58; vogfar3:=5; vogfar4:=57;
    setrgbpalette(hellgrau, 120, 120, 120);
    setrgbpalette(felsen, 20, 20, 20);
    setrgbpalette(sonne, 250, 250, 220);
    setrgbpalette(strahlen, 250, 250, 220);
    setrgbpalette(weg, 250, 230, 0);
    setrgbpalette(holz, 175, 100, 30);
    setrgbpalette(wasser, 20, 20, 250);
    for i:=0 to 8 do quarz[i] := 0;
    for i:=1 to 2 do quarz[i*4] := random(8);
  end;

{****************************************************************************}

procedure vogel;

  var x, y, farbe    : array[1..4] of integer;
      ranzahl        : 0..640;
      fuell1, fuell2 : word;
      farb1, farb2   : word;

  procedure fluegel(x, y: integer; weg : boolean; anz: integer);
    begin
      if weg=false
        then begin
               fuell1:=65500;
               fuell2:=35;
               farb1:=farbe[anz];
               farb2:=felsen;
             end
        else begin
               fuell1:=65535;
               fuell2:=65535;
               farb1:=himmel;
               farb2:=himmel;
             end;
      if c=0
        then begin
               setcolor(farb1);
               setlinestyle(4, fuell1, 1);
               line(z+a-i, z1+b, x-i, y);  {links oben}
               line(x+i, y, z3-a+i, z1+b); {rechts oben}
               setlinestyle(4, fuell2, 1);
               setcolor(farb2);
               line(z+a-i, z1+b, x-i, y);  {links oben}
               line(x+i, y, z3-a+i, z1+b); {rechts oben}
               setrgbpalette(strahlen, 0, 255, 255);
             end
        else begin
               setcolor(farb1);
               setlinestyle(4, fuell1, 1);
               line(z+a-i, y+i, x-i, y);   {links unten}
               line(x+i, y, z3-a+i, y+i);  {rechts unten}
               setcolor(farb2);
               setlinestyle(4, fuell2, 1);
               line(z+a-i, y+i, x-i, y);   {links unten}
               line(x+i, y, z3-a+i, y+i);  {rechts unten}
               setrgbpalette(strahlen, 250, 250, 220);
             end;
    end;

  procedure einstellungen;
    begin
      farbe[1]:=vogfar1;
      farbe[2]:=vogfar2;
      farbe[3]:=vogfar3;
      farbe[4]:=vogfar4;
      i:=24;
      for anz:=1 to anzz do
        begin
          x[anz]:=-300;
          y[anz]:=-300;
        end;
      rananz:=random(anzz)+1;
      if rananz=1 then ranzahl:=400;
      if rananz=2 then ranzahl:=200;
      if rananz=3 then ranzahl:=80;
      if rananz=4 then ranzahl:=40;
      for anz:=1 to rananz do
        begin
          x[anz]:=(round(600/rananz)*(anz)-50-random(ranzahl)) mod 640;
          y[anz]:=250+random(50);
          setrgbpalette(farbe[anz], random(255), random(255), random(255));
          setcolor(farbe[anz]);
          setfillpattern(vogelfuellmuster, farbe[anz]);
          fillellipse(x[anz], y[anz], 21, i);
        end;
    end;

  begin  {of procedure vogel}
     einstellungen;
     i:=24;
     for i:=21 downto 0 do
       begin
         for anz:=1 to anzz do
           begin
             z:=x[anz]-100;
             z1:=y[anz]-21; z3:=x[anz]+100;
             setcolor(himmel);
             ellipse(x[anz], y[anz], 0, 360, i, i+3);
             ellipse(x[anz], y[anz]+1, 0, 360, i, i+3);
             ellipse(x[anz], y[anz]-1, 0, 360, i, i+3);
             setcolor(farbe[anz]);
             c:=i mod 2;
             fluegel(x[anz], y[anz], false, anz);
             if keypressed then exit;
             delay(round(100/anzz));
           end;
         for anz:=1 to anzz do
           begin
             z:=x[anz]-100;
             z1:=y[anz]-21; z3:=x[anz]+100;
             setcolor(himmel);
             c:=i mod 2;
             fluegel(x[anz], y[anz], true, anz);
           end{of for anz};
         a:=a+zahl; b:=b+1;
      end{of for i};
    a:=0; b:=0;
    delay(100);
    setcolor(himmel);
    setfillstyle(1, himmel);
    for anz:=1 to anzz do
      begin
        pieslice(x[anz], y[anz], 0, 360, 2);
      end{of for i};
  end{of procedure};

{****************************************************************************}

procedure wolkenzeich;

  var xr, yr : byte;
      xp, yp : 0..640;
      farbe, j : word;
      wink   : real;

  begin
    setcolor(weiss);
    setfillstyle(1, weiss);
    xr:=random(130);
    yr:=6+random(xr div 2);
    xp:=random(639); yp:=random(130);
    fillellipse(xp, yp, xr-4, yr-4);
    for j:=1 to 360 do
      begin
        setcolor(weiss);
        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(hellgrau);
    setfillstyle(1, hellgrau);
    fillellipse(xp, yp+8, xr-15, yr-20);
    for j:=1 to 360 do
      begin
        setcolor(hellgrau);
        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 berge;

  var i, yj, yv : integer;

  begin
    line(0, 479, 200, 400);
    line(639, 479, 440, 400);
    line(200, 400, 200, 350);
    line(440, 400, 440, 350);
    {setlinestyle(2, 0, 1);
    setcolor(weiss);
    line(0, 479, 200, 400);
    line(639, 479, 440, 400);
    line(200, 400, 200, 350);
    line(440, 400, 440, 350);
    setlinestyle(0, 0, 1);
    setcolor(felsen);}
    yv:=400;
    for i:=1 to 19 do
      begin
        felseny[10*i]:=random(25);
        yj:=400-round(i*2.5)-felseny[10*i];
        line(10*(i-1), yv, 10*i, yj);
        {setlinestyle(2, 0, 1);
        setcolor(weiss);
        line(10*(i-1), yv, 10*i, yj);
        setlinestyle(0, 0, 1);
        setcolor(felsen);}
        yv:=yj;
      end;
    line(190, yv, 200, 350);
    yv:=350;
    for i:=1 to 19 do
      begin
        yj:=350+round(i*2.5)-random(25);
        line(440+10*(i-1), yv, 440+10*i, yj);
        yv:=yj;
      end;
    line(630, yv, 639, 400);
    setfillpattern(quarz, weiss);
    floodfill(635, 401, felsen);
    floodfill(5, 401, felsen);
  end;

procedure weguhaus;
  begin
    setcolor(weg);
    line(295, 479, 300, 460);
    line(320, 460, 325, 479);
    ellipse(320, 460, 90, 180, 20, 19);
    ellipse(331, 460, 90, 180, 11, 10);
    ellipse(321, 435, 270, 360, 7, 6);
    ellipse(331, 440, 270, 360, 11, 10);
    line(328, 435, 332, 400);
    line(341, 440, 334, 400);
    line(332, 400, 334, 400);
    setfillstyle(1, weg);
    floodfill(310, 475, weg);
    setfillstyle(1, holz);
    setcolor(holz);
    bar(330, 400, 336, 405);
    line(328, 402, 333, 395);
    line(333, 395, 338, 402);
    floodfill(333, 398, holz);
  end;

procedure sonnezeich;

  var wink : real;

  begin
    setcolor(sonne);
    setfillstyle(1, sonne);
    pieslice(320, 0, 0, 360, 50);
    setcolor(strahlen);
    for i:=1 to 17 do
      begin
        wink:=i*10*Pi/180;
        line(320+round(cos(wink)*51), 0+round(sin(wink)*51),
             320+round(cos(wink)*150), 0+round(sin(wink)*150));
      end;
  end;

procedure wasserfall(var mp : integer);

  var ymin, yp, yp2 : integer;

  begin
    ymin:=40;
    setcolor(wasser);
    setfillstyle(1, wasser);
    for i:=8 to 18 do
      if felseny[i*10]<ymin then
        begin
          ymin:=felseny[i*10];
          mp:=i;
        end;
    yp:=400-round(mp*2.5)-ymin;
    yp2:=480;
    bar(mp*10-5, yp-5, mp*10+5, yp2);
  end;

procedure wasserfall2(mp : integer);

  var yp, yp2 : integer;

  begin
    yp:=random(200);
    yp2:=yp+200;
    mp:=mp*10;
    setcolor(wasser);
    line(mp-38, 479, mp-33, 470);
    line(mp-13, 470, mp-8, 479);
    ellipse(mp-13, 470, 90, 180, 20, 19);
    ellipse(mp-2, 470, 90, 180, 11, 10);
    ellipse(mp-12, 445, 270, 360, 7, 6);
    ellipse(mp-2, 450, 270, 360, 11, 10);
    line(mp-5, 445, mp-5, 400);
    line(mp+8, 450, mp+5, 400);
    line(mp-5, 400, mp+5, 400);
    setfillstyle(1, wasser);
    floodfill(mp-35, 478, wasser);
  end;

{----------------------------------------------------------------------------}

procedure hintergrund;

  var y, wx : integer;

  begin
    setbkcolor(felsen);
    setcolor(felsen);
    berge;
    setcolor(himmel);
    setfillstyle(1, himmel);
    floodfill(320, 250, felsen);
    sonnezeich;
    for i:=1 to random(11) do wolkenzeich;
    setfillpattern(quarz, weiss); setcolor(felsen);
    bar(310, 350, 340, 400);
    y:=8+random(20)+325;
    line(310, 350, 325, y);
    line(325, y, 340, 350);
    floodfill(320, 349, felsen);
    wasserfall(wx);
    setcolor(wiese);
    line(0, 479, 200, 400);
    line(639, 479, 440, 400);
    line(200, 400, 440, 400);
    setfillstyle(1, wiese);
    floodfill(320, 475, wiese);
    wasserfall2(wx);
    weguhaus;
  end;

{****************************************************************************}

begin
  randomize;
  a:=0; i:=0; b:=0; c:=0; durchlauf:=0;
  graphdriver:=9; graphmode:=2;
  initgraph(graphdriver, graphmode , 'd:\tp\bgi');
  farben;
  zahl:=4;
  hintergrund;
  setlinestyle(0, 0, 1);
  repeat
    randomize;
    anzz:=4;
    vogel;
    setviewport(0, 0, 639, 479, false);
    a:=0; i:=50; b:=0; c:=0;
    inc(durchlauf);
    if durchlauf = 10 then
      begin
        cleardevice;
        durchlauf:=0;
        randomize;
        hintergrund;
      end;
  UNTIL KeyPressed ;
  readln;
  closegraph;
end.