home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Pascal / TURTLE10.ZIP / TURTLEDM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-14  |  4.5 KB  |  149 lines
  1. {------------------------------------------------------------------------}
  2. { PROJECT   : Turtle graphics using BGI                                  }
  3. { MODULE    : TURTLEDM.PAS                                               }
  4. {------------------------------------------------------------------------}
  5. { GOAL      : Test program. Code (C) Borland Int'l TurboPascal V3.0      }
  6. {           : most of the code of this program, but initialisation part  }
  7. {           : was provided as a demo in Turbopascal V3.0 package         }
  8. { VERSION   : 1.0                                                        }
  9. {------------------------------------------------------------------------}
  10. { REVISIONS :                                                            }
  11. {------------------------------------------------------------------------}
  12. { AUTHOR    : P.Pollet INSA  14/06/91                                    }
  13. {------------------------------------------------------------------------}
  14.  
  15. program PlayTurtle;
  16.  
  17. USES GRAPH,TURTLE,CRT;
  18.  const
  19.    TurtleSpeed = 50;
  20.  
  21.  type
  22.    ToggleCommands = (PenOn, WrapOn, TurtleOn);
  23.  
  24.  var
  25.    ToggleRay    : array[PenOn..TurtleOn] of boolean;
  26.    Magnitude,
  27.    Color,
  28.    CurentPalette: Integer;
  29.  
  30.  Procedure Init;
  31.  var  Toggle: ToggleCommands;
  32.  begin
  33.    Magnitude := 0;
  34.    Color     := 0;
  35.    for Toggle := PenOn to TurtleOn do
  36.      ToggleRay[Toggle]  := true;
  37.  end;
  38.  
  39.  Procedure PlayWithTurtle;
  40.  
  41.  var
  42.    InKey:     Char;
  43.    FunctionKey:  Boolean;
  44.  
  45.    procedure NewScreen;
  46.    begin
  47.        ClearScreen;
  48.        TurtleWindow(GetMaxX div 2,(GetMaxY div 2)-10, GetMaxX-100,GetMaxY-60);
  49.        TurtleBox(Blue);
  50.        OutTextXY(25,GetMaxY-30,'SPEED:0-9  TOGGLES:,(L)ig,(T)urtle,(C)ol.'+
  51.                              'TURN : F1,F2, HOME : +, (E)rase');
  52.        Showturtle;
  53.        home;
  54.        Wrap;
  55.        Magnitude := 0;
  56.    end; { NewScreen }
  57.  
  58.    Function GetKey(var FunctionKey: Boolean): char;
  59.    var ch: char;
  60.    begin
  61.      Ch:=ReadKey;
  62.      If (Ch = #0) AND KeyPressed Then  { Function key }
  63.      begin
  64.        Ch:=ReadKey;
  65.        FunctionKey := true;
  66.      end
  67.      else FunctionKey := false;
  68.      GetKey := Ch;
  69.    end;
  70.  
  71.  
  72.    Procedure TurtleDo(InKey : char; FunctionKey : boolean);
  73.    const
  74.      NorthEast = 45;
  75.      SouthEast = 135;
  76.      SouthWest = 225;
  77.      NorthWest = 315;
  78.  
  79.      procedure DoFunctionCommand(FunctionKey: char);
  80.      begin
  81.        case FunctionKey of
  82.          'H': SetHeading(North);      { up arrow        }
  83.          'P': SetHeading(South);      { down arrow      }
  84.          'M': SetHeading(East);       { left arrow      }
  85.          'K': SetHeading(West);       { right arrow     }
  86.          'I': SetHeading(NorthEast);  { PgUp            }
  87.          'Q': SetHeading(SouthEast);  { PgDn            }
  88.          'G': SetHeading(NorthWest);  { Home            }
  89.          'O': SetHeading(SouthWest);  { End             }
  90.          '<': SetHeading(Heading+5);  { F1              }
  91.          ';': SetHeading(Heading-5);  { F2              }
  92.        end
  93.      end { Do function command };
  94.  
  95.    begin
  96.      If FunctionKey then DoFunctionCommand(Upcase(InKey))
  97.      else
  98.      case upcase(InKey) of
  99.        'P': begin
  100.               ToggleRay[PenOn] := NOT ToggleRay[PenOn];
  101.               case ToggleRay[PenOn] of
  102.                 true  : PenUp;
  103.                 false : PenDown;
  104.               end; (* case *)
  105.             end;
  106.        'L': begin
  107.               ToggleRay[WrapOn] := NOT ToggleRay[WrapOn];
  108.               case ToggleRay[WrapOn] of
  109.                 true  : Wrap;
  110.                 false : NoWrap;
  111.               end; (* case *)
  112.             end;
  113.        'T': begin
  114.               ToggleRay[TurtleOn] := NOT ToggleRay[TurtleOn];
  115.               case ToggleRay[TurtleOn] of
  116.                 true  : ShowTurtle;
  117.                 false : HideTurtle;
  118.               end; (* case *)
  119.             end;
  120.        '+': Home;
  121.        'C': begin
  122.               Color := succ(color) Mod (GetMaxColor+1);
  123.               SetPenColor(Color);
  124.             end;
  125.        'E': NewScreen;
  126.        '0'..'9': Magnitude := Sqr(ord(inkey) - ord('0'));
  127.      end;   { case }
  128.    end; (* TurtleDo *)
  129.  
  130.  begin
  131.   NewScreen;
  132.   repeat
  133.     TurtleDelay(TurtleSpeed);
  134.     repeat
  135.       if Magnitude <> 0 then forwd(Magnitude);
  136.     until KeyPressed;
  137.     Inkey := GetKey(FunctionKey);
  138.     TurtleDo(InKey, FunctionKey);
  139.   until UpCase(Inkey) in [#27, ^C];
  140.  end;  { PlayWithTurtle }
  141.  
  142. begin
  143.   Init;
  144.   GraphOn(EGA,EGAHI,'');
  145.   PlayWithTurtle;
  146.   ClearScreen;
  147.   GraphOff;
  148. end.
  149.