home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Pascal / TURTLE10.ZIP / NICETREE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-14  |  3.1 KB  |  118 lines
  1. {------------------------------------------------------------------------}
  2. { PROJECT   : Turtle graphics using BGI                                  }
  3. { MODULE    :  NICETREE.PAS                                              }
  4. {------------------------------------------------------------------------}
  5. { GOAL      : Demo: Draw a nice tree                                     }
  6. { VERSION   : 1.0                                                        }
  7. {------------------------------------------------------------------------}
  8. { REVISIONS :                                                            }
  9. {------------------------------------------------------------------------}
  10. { AUTHOR    : P.Pollet INSA  17/06/91                                    }
  11. {------------------------------------------------------------------------}
  12.  
  13. program NiceTree;
  14.  
  15. uses graph,Turtle,crt;
  16.  
  17. {..$DEFINE SVGA}
  18.  
  19. {$IFDEF SVGA}
  20.    {$I SVGA.INI}
  21. {$ENDIF}
  22.  
  23. procedure Fruit;
  24. { some red cherries }
  25. var I:Byte;
  26. begin
  27.    If Random(2)=1  then
  28.      begin
  29.        SetPenColor(RED);
  30.        For I:=1 to 8 do
  31.          begin
  32.            Forwd(2);TurnRight(45)
  33.          end
  34.      end
  35. end;
  36.  
  37. procedure Trunk (Width, Len:integer);
  38. begin
  39.   If Width>0 then
  40.     begin
  41.        Forwd(Width div 2);
  42.        TurnLeft(90) ;Forwd(Len);
  43.        TurnLeft(90) ;Forwd(Width);
  44.        TurnLeft(90) ;Forwd(Len);
  45.        TurnLeft(90) ;Forwd(Width div 2 );
  46.        Trunk(Width-2,Len)
  47.      end
  48. end;
  49.  
  50.  
  51. procedure Tree (Len,Angle,N:integer;
  52.                   Kleft,KCenter,KRight:Real;
  53.                   Curve,
  54.                   Delta:integer;
  55.                   Alternate:Boolean);
  56.  
  57. begin
  58.   If  (N>0) then
  59.     begin
  60.       If N > 4 then
  61.         begin
  62.           SetPenColor(BROWN);
  63.           TurnRight(90);
  64.           Trunk(N-1,Len);
  65.           TurnLeft(90);
  66.           Forwd(Len);
  67.         end
  68.      else
  69.         begin
  70.           SetPenColor(GREEN);
  71.           Forwd(Len)
  72.         end;
  73.      TurnLeft(Angle);
  74.      Tree(Round(Len*KLeft),Angle-Delta,N-1,KLeft,KCenter,KRight,Curve,Delta,Alternate);
  75.      If not Alternate or odd(N) then  TurnRight(Angle+Curve)
  76.                           else  TurnRight(Angle-Curve);
  77.      Tree(Round(Len*KCenter),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*KRight),Angle-Delta,N-1,KLeft,KCenter,KRight,Curve,Delta,Alternate);
  81.      TurnLeft(Angle);
  82.      If N > 4 then
  83.         begin
  84.           SetPenColor(BROWN);
  85.           TurnLeft(90);
  86.           Trunk(N-2,Len);
  87.           TurnRight(90);
  88.           Back(Len);
  89.           (*If Readkey=' ' then ;*)
  90.         end
  91.      else
  92.        begin
  93.          SetPenColor(GREEN);
  94.          Back(Len);
  95.        end;
  96.      If n=2 Then Fruit
  97.    end
  98. end;
  99.  
  100. var i:integer;
  101.  
  102. begin
  103.   {$IFDEF SVGA}
  104.     Initialize;
  105.     InitTurtle;
  106.   {$ELSE}
  107.     graphon(VGA,VGAHI,'');
  108.   {$ENDIF}
  109.   PenUp;
  110.   Home;
  111.   Forwd(-150);
  112.   PenDown;
  113.   Tree(60,34,7,0.63,0.84,0.7,20,-2,False);
  114.   readln;
  115.   GraphOff
  116. end.
  117.  
  118.