home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Pascal / TURTLE10.ZIP / FOREST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-14  |  3.6 KB  |  145 lines
  1. {------------------------------------------------------------------------}
  2. { PROJECT   : Turtle graphics using BGI                                  }
  3. { MODULE    :  FOREST.PAS                                                }
  4. {------------------------------------------------------------------------}
  5. { GOAL      : Demo: Draw a forest of 25 random "nice trees"              }
  6. { VERSION   : 1.0                                                        }
  7. {------------------------------------------------------------------------}
  8. { REVISIONS :                                                            }
  9. {------------------------------------------------------------------------}
  10. { AUTHOR    : P.Pollet INSA  17/06/91                                    }
  11. {------------------------------------------------------------------------}
  12.  
  13. program Forest;
  14. {$R-}
  15. uses graph,Turtle,crt;
  16.  
  17. {..$DEFINE SVGA}
  18.  
  19. {$IFDEF SVGA}
  20.    {$I SVGA.INI}
  21. {$ENDIF}
  22.  
  23.  
  24. procedure Fruit;
  25. { some red cherries }
  26. var I:Byte;
  27. begin
  28.    If Random(2)=1  then
  29.      begin
  30.        SetPenColor(RED);
  31.        For I:=1 to 8 do
  32.          begin
  33.            Forwd(2);TurnRight(45)
  34.          end
  35.      end
  36. end;
  37.  
  38. procedure Trunk (Width, Len:integer);
  39. begin
  40.   If Width>0 then
  41.     begin
  42.        Forwd(Width div 2);
  43.        TurnLeft(90) ;Forwd(Len);
  44.        TurnLeft(90) ;Forwd(Width);
  45.        TurnLeft(90) ;Forwd(Len);
  46.        TurnLeft(90) ;Forwd(Width div 2 );
  47.        Trunk(Width-2,Len)
  48.      end
  49. end;
  50.  
  51.  
  52.  
  53.  
  54. procedure Tree (Len,Angle,N:integer;
  55.                   Kleft,KCenter,KRight:Real;
  56.                   Curve,
  57.                   Delta:integer;
  58.                   Alternate:Boolean);
  59.  
  60. begin
  61.   If  (N>0) then
  62.     begin
  63.       If N > 4 then
  64.         begin
  65.           SetPenColor(BROWN);
  66.           TurnRight(90);
  67.           Trunk(N-1,Len);
  68.           TurnLeft(90);
  69.           Forwd(Len);
  70.         end
  71.      else
  72.         begin
  73.           SetPenColor(GREEN);
  74.           Forwd(Len)
  75.         end;
  76.      TurnLeft(Angle);
  77.      Tree(Round(Len*KLeft),Angle-Delta,N-1,KLeft,KCenter,KRight,Curve,Delta,Alternate);
  78.      If not Alternate or odd(N) then  TurnRight(Angle+Curve)
  79.                           else  TurnRight(Angle-Curve);
  80.      Tree(Round(Len*KCenter),Angle-Delta,N-1,KLeft,KCenter,KRight,Curve,Delta,Alternate);
  81.      If not Alternate or  odd(N) then  TurnRight(Angle-Curve)
  82.                           else  TurnRight(Angle+Curve);
  83.      Tree(Round(Len*KRight),Angle-Delta,N-1,KLeft,KCenter,KRight,Curve,Delta,Alternate);
  84.      TurnLeft(Angle);
  85.      If N > 4 then
  86.         begin
  87.           SetPenColor(BROWN);
  88.           TurnLeft(90);
  89.           Trunk(N-2,Len);
  90.           TurnRight(90);
  91.           Back(Len);
  92.           (*If Readkey=' ' then ;*)
  93.         end
  94.      else
  95.        begin
  96.          SetPenColor(GREEN);
  97.          Back(Len);
  98.        end;
  99.      If n=2 Then Fruit
  100.    end
  101. end;
  102.  
  103. var i,L,Na,N:integer;
  104.     Ch:char;
  105.  
  106. begin
  107.  
  108.   Randomize;
  109.   {$IFDEF SVGA}
  110.     Initialize;
  111.     InitTurtle;
  112.   {$ELSE}
  113.     graphon(VGA,VGAHI,'');
  114.   {$ENDIF}
  115.   Repeat
  116.     ClearScreen;
  117.     PenUp;
  118.     Home;
  119.     Forwd(-150);
  120.     PenDown;
  121.     (*ShowTurtle;*)
  122.     Na:=25;
  123.  
  124.     For I:=1 to Na do
  125.       begin
  126.         L:= Random(40+i) +40;
  127.       If L> 25 then N:=Random(2)+6
  128.                else N:=Random(2)+5;
  129.       SetPosition(Random(GetMaxX-L)-(GetMaxX-L) div 2,
  130.                   -(100 div 2) div Na *I-(100 div 2) );
  131.       Tree(L,
  132.              Random(35)+25,
  133.              N,
  134.              (Random(20)+45)/100,
  135.              (Random(20)+55)/100,
  136.              (Random(20)+45)/100,
  137.              Random(10)-4,
  138.              Random(30)-15,
  139.              Random(2)=1);
  140.     end;
  141.   Ch:=ReadKey;
  142.  until (Ch=Char(27));
  143.  GraphOff
  144. end.
  145.