Turbo Toolbox/Turbo_Toolbox.iso/turbo4/gr3demo.pas

Pascal/Delphi Source File | 1987-12-08 | 6.8 KB | 243 lines

{           Copyright (c) 1985, 87 by Borland International, Inc.            }

program Gr3Demo;
{
                Turtlegrafik-Demonstration

  Dieses Programm demonstriert die Implementation der Turtlegrafik
  der Version 3.0 durch das Unit Graph3 in der Version 4.0.

  HINWEIS: Das Unit Graph3 (und damit GR3DEMO.PAS) setzen einen Color
  Graphics Adapter ("CGA") voraus (im Gegensatz zum Unit Graph, das
  eine Vielzahl von Grafik-Adaptern unterstützt).

  Eine kurze Beschreibung des Ablaufs:

  1.  Initialisierung der Variablen
  2 a. Start mit mittlerer Auflösung
    b. Einlesen eines Zeichens von der Tastatur und entsprechende
       Manipulation der "Schildkröte" bis zum nächsten Tastendruck
  3.   Ende des Programms bei Eingabe von ESC oder Ctrl-C (Umschaltung in
       den Textmodus).

  Die folgenden Tastenbefehle werden vom Programm unterstützt:

      F1           dreht die Schildkröte nach links
      F2           dreht die Schildkröte nach rechts

      <Auf>        Schildkröte nach oben ("North")
      <Ab>                     nach unten ("South")
      <Links>                  nach links ("West")
      <Rechts>                 nach rechts ("East")
      <Home>        Nordwest
      <PgUp>        NordOst
      <PgDn>        SüdOst
      <End>         SüdWest


      0..9          bestimmen die Geschwindigkeit der Schildkröte (0 = Stop,
                    1 = langsam, 9 = sehr schnell)
       H            setzt hohe Auflösung
       M            setzt mittlere Auflösung
       W            schaltet den "Wrap"-Modus an/aus
       P            setzt den Zeichenstift an/hebt ihn ab
       C            ändert die Zeichenfarbe (bzw. Helligkeit)
       T            versteckt/zeigt die Schildkröte
       +            setzt die Schildkröte wieder in ihre Anfangsposition
      <ESC>         beendet das Programm
}

uses
  Crt, Turbo3, Graph3;

const
  TurtleSpeed = 50;

type
  ToggleCommands = (PenOn, WrapOn, TurtleOn);

var
  ToggleRay    : array[PenOn..TurtleOn] of Boolean;
  Magnitude,               { Geschwindigkeit: 0 = Stop, 9 = sehr schnell }
  Color,                   { momentane Zeichenfarbe (in der Palette) }
  CurentPalette: Integer;  { momentane Palette }

procedure Init;
var  Toggle: ToggleCommands;

procedure VerifyGraphicsCard;
var ch : Char;
begin
  ClrScr;
  Writeln('Dieses Programm setzt einen Color Graphics Adapter voraus!');
  write('Ist Ihr Computer entsprechend ausgerüstet? (J/N): ');
  repeat
    read (Kbd, Ch); ch := UpCase(ch);
    if ch in ['N', #27, ^C] then
    begin
      TextMode(LastMode);
      Halt;
    end;
  until ch = 'J';
end;

begin
  VerifyGraphicsCard;
  Magnitude := 0;  { Stop }
  Color     := 0;
  for Toggle := PenOn to TurtleOn do
    ToggleRay[Toggle]  := True;      { alle Umschalter auf ON }
end;

procedure PlayWithTurtle;
var
  InKey:     Char;

FunctionKey:  Boolean;    { True, wenn eine Spezialtaste gedrückt wurde }

procedure NewScreen(SetRes : Char);

procedure DrawBox(x, y, w, h : Integer);
begin
  Draw(x, y, x + w, y, 1);                     { Spitze }
  Draw(x, y, x, y + h, 1);                     { linke Seite }
  Draw(x, y + h, x + w, y + h, 1);             { Unterseite }
  Draw(x + w, y + h, x + w, y, 1);             { rechte Seite }
end; { DrawBox }

procedure HiResOn;
const
  CharHeight = 10;
begin
  HiRes;
  HiResColor(Yellow);
  DrawBox(0, 0, 639, 199-CharHeight);
  TurtleWindow(319, 99-(CharHeight DIV 2), 638, 198-CharHeight);
end; { HiResOn }

procedure MediumResOn;
const
  CharHeight = 20;
begin
  GraphColorMode;
  DrawBox(0, 0, 319, 199-CharHeight);
  TurtleWindow(159, 99-(CharHeight DIV 2), 318, 198-CharHeight);
end; { MediumResOn }

begin
  case SetRes of
    'M'   : begin
              MediumResOn;
              GoToXY(1, 24);
              writeln('Verz.:0-9 Umsch.:Pen,Wrap,Turtle,Color');
              write  ('Drehung:F1,F2, HOME: +, Modus: Hi,Med');
            end;
    'H'   : begin
              HiResOn;
              GoToXY(1, 25);
              write('Verz.:0-9 Umsch.:Pen,Wrap,Turtle,Color');
              write(' Drehung:F1,F2, HOME: +, Modus: Hi,Med');
            end;
  end; { case }
  Showturtle;
  Home;
  Wrap;
  Magnitude := 0;
end;

function GetKey(var FunctionKey: Boolean): Char;
var ch: Char;
begin
  ch := ReadKey;
  if (Ch = #0) then  { .. muß es wohl eine Funktionstaste sein }
  begin
    ch := ReadKey;
    FunctionKey := True;
  end
  else FunctionKey := False;
  GetKey := Ch;
end;

procedure TurtleDo(InKey : Char; FunctionKey : Boolean);
const
  NorthEast = 45;
  SouthEast = 135;
  SouthWest = 225;
  NorthWest = 315;

procedure DoFunctionCommand(FunctionKey: Char);
begin
  case FunctionKey of
    'H': SetHeading(North);      { Aufwärtspfeil }
    'P': SetHeading(South);      { Abwärtspfeil }
    'M': SetHeading(East);       { Linkspfeil }
    'K': SetHeading(West);       { Rechtspfeil }
    'I': SetHeading(NorthEast);  { PgUp            }
    'Q': SetHeading(SouthEast);  { PgDn            }
    'G': SetHeading(NorthWest);  { Home            }
    'O': SetHeading(SouthWest);  { End             }
    '<': SetHeading(Heading+5);  { F1              }
    ';': SetHeading(Heading-5);  { F2              }
  end
end;

begin
  if FunctionKey then DoFunctionCommand(UpCase(InKey))
  else
  case UpCase(InKey) of
    'P': begin
           ToggleRay[PenOn] := NOT ToggleRay[PenOn];
           case ToggleRay[PenOn] of
             True  : PenUp;
             False : PenDown;
           end; { case }
         end;
    'W': begin
           ToggleRay[WrapOn] := NOT ToggleRay[WrapOn];
           case ToggleRay[WrapOn] of
             True  : Wrap;
             False : NoWrap;
           end; { case }
         end;
    'T': begin
           ToggleRay[TurtleOn] := NOT ToggleRay[TurtleOn];
           case ToggleRay[TurtleOn] of
             True  : ShowTurtle;
             False : HideTurtle;
           end; { case }
         end;
    '+': Home;
    'C': begin
           Color := succ(color) mod 4;
           SetPenColor(Color);
         end;
    '0'..'9': Magnitude := Sqr(ord(inkey) - ord('0'));
    'M': begin
           NewScreen('M');     { mittlere Grafik-Auflösung }
         end;
    'H': begin
           NewScreen('H');     { HiRes-Grafik }
         end;
  end;   { case }
end; { TurtleDo }

begin { PlayWithTurtle }
  NewScreen('M');     { Start mit mittlerer Auflösung }
  repeat
    TurtleDelay(TurtleSpeed);
    repeat
      if Magnitude <> 0 then forwd(Magnitude);
    until KeyPressed;
    Inkey := GetKey(FunctionKey);
    TurtleDo(InKey, FunctionKey);
  until UpCase(Inkey) in [#27, ^C];
end;

begin { Hauptprogramm }
  Init;
  PlayWithTurtle;
  ClearScreen;
  TextMode(LastMode);
end.