Turbo Toolbox/Turbo_Toolbox.iso/1991/03/ldm/world.pas

Pascal/Delphi Source File | 1991-01-02 | 12.2 KB | 484 lines

(* ------------------------------------------------------ *)
(*                     WORLD.PAS                          *)
(*                                                        *)
(* Unit zur Umrechnung fester auf gegebene Koordinaten.   *)
(* Beachten Sie bitte, daß die Parameter der Prozedur     *)
(* "GivenWorld" keine Variablen oder Funktionen erhalten  *)
(* dürfen, die sich bei jedem Programmstart, Computer-    *)
(* oder Systemzustand ändern.                             *)
(* Falsch ist also:                                       *)
(*    GivenWorld(GetMaxX, GetMaxY);                       *)
(* Richtig ist :                                          *)
(*    GivenWorld(640, 480);                               *)
(*                                                        *)
(*         (c) 1991 Hagen Lehmann & TOOLBOX               *)
(* -----------------------------------------------------  *)
UNIT  World;

{$IFDEF VER40}
  {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L- }
{$ELSE}
  {$A+,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V- }
{$ENDIF}

{$M 16384,0,655360 }

INTERFACE

USES  Graph;

CONST
  MaxWorld  = 10;             { maximale Anzahl von Welten }

TYPE
  WorldType = RECORD     { Abspeicherungstyp der Weltdaten }
                X1, Y1, X2, Y2 : WORD;       { Koordinaten }
                Clipping       : BOOLEAN;       { Clipping }
              END;

{ WORLD-spezifische Befehle }

  PROCEDURE GivenWorld(MaxX, MaxY : WORD);

  PROCEDURE DefineWorld(Number         : WORD;
                        X1, Y1, X2, Y2 : WORD;
                        Clip           : BOOLEAN);

  PROCEDURE DefineWorldByType(Number    : WORD;
                              WorldData : WorldType);

  PROCEDURE SelectWorld(Number : WORD);

  PROCEDURE ResetWorlds;

  PROCEDURE Clear(Number : WORD);

  PROCEDURE ClearWorld;

  PROCEDURE AwakeWorld;

  PROCEDURE SleepWorld;

  FUNCTION  GetWorld : WORD;

  PROCEDURE GetGivenWorld(VAR MaxX, MaxY : WORD);

  PROCEDURE GetWorldData(    Number    : WORD;
                         VAR WorldData : WorldType);

  FUNCTION  GetFactorX(Number : WORD) : REAL;

  FUNCTION  GetFactorY(Number : WORD) : REAL;

(* ---- neue Deklarationen der X,Y-Grafikbefehle -------- *)

  PROCEDURE Arc(X, Y                      : INTEGER;
                StAngle, EndAngle, Radius : WORD);

  PROCEDURE Bar(X1, Y1, X2, Y2 : INTEGER);

  PROCEDURE Bar3D(X1, Y1, X2, Y2 : INTEGER;
                  Depth          : WORD;
                  Top            : BOOLEAN);

  PROCEDURE Circle(X, Y : INTEGER; Radius : WORD);

  PROCEDURE Ellipse(X, Y               : INTEGER;
                    StAngle, EndAngle,
                    XRadius, YRadius   : WORD);

  PROCEDURE FloodFill(X, Y : INTEGER; Border : WORD);

  PROCEDURE GetImage(X1, Y1, X2, Y2 : INTEGER; VAR BitMap);

  FUNCTION  GetPixel(X, Y : INTEGER) : WORD;

  FUNCTION  ImageSize(X1, Y1, X2, Y2 : INTEGER) : WORD;

  PROCEDURE Line(X1, Y1, X2, Y2 : INTEGER);

  PROCEDURE LineRel(DX, DY : INTEGER);

  PROCEDURE LineTo(X, Y : INTEGER);

  PROCEDURE MoveRel(DX, DY : INTEGER);

  PROCEDURE MoveTo(X, Y : INTEGER);

  PROCEDURE OutTextXY(X, Y : INTEGER; TextString : STRING);

  PROCEDURE PieSlice(X, Y                      : INTEGER;
                     StAngle, EndAngle, Radius : WORD);

  PROCEDURE PutImage(X, Y : INTEGER; VAR BitMap;
                     BitBlt : WORD);

  PROCEDURE PutPixel(X, Y : INTEGER;Pixel : WORD);

  PROCEDURE Rectangle(X1, Y1, X2, Y2 : INTEGER);

  PROCEDURE SetViewPort(X1, Y1, X2, Y2 : INTEGER;
                        Clip           : BOOLEAN);

(* ------------------------------------------------------ *)
IMPLEMENTATION

VAR
  CalledGiven   : BOOLEAN;
  Loop,
  Selected,
  SleepNumber   : WORD;
  Given         : RECORD
                    X, Y : WORD;
                  END;
  Worlds        : ARRAY [1..MaxWorld] OF WorldType;
  SleepingWorld : WorldType;
  FactorX,
  FactorY       : ARRAY [1..MaxWorld] OF REAL;

(* ---- WORLD-interne Befehle --------------------------- *)

  PROCEDURE SwapWord(VAR One, Two : WORD);
    { Vertausch zweier Wortwerte }
  VAR
    Temp : WORD;
  BEGIN
    Temp := One;
    One  := Two;
    Two  := Temp;
  END;

  PROCEDURE CalcFour(VAR One,Two,Three,Four : INTEGER);
    { berechnet vier Koordinaten neu }
  BEGIN
    One   := Round(One/FactorX[Selected]);
    Two   := Round(Two/FactorY[Selected]);
    Three := Round(Three/FactorX[Selected]);
    Four  := Round(Four/FactorY[Selected]);
  END;

  PROCEDURE CalcTwo(VAR One, Two : INTEGER);
    { berechnet zwei Koordinaten neu }
  BEGIN
    One := Round(One/FactorX[Selected]);
    Two := Round(Two/FactorY[Selected]);
  END;

(* ------------------------------------------------------ *)

  PROCEDURE GivenWorld;
  { gibt die Welt an, die beim Programmieren benutzt wurde }
  BEGIN
    CalledGiven := TRUE;     { GivenWorld wurde aufgerufen }
    Given.X     := MaxX;     { maximale X-Werte übergeben  }
    Given.Y     := MaxY;     { maximale Y-Werte übergeben  }
  END;


  PROCEDURE DefineWorld;
   { definiert eine neue Welt (maximal <MaxWorld> Welten) }
  BEGIN
    IF CalledGiven THEN BEGIN
      IF NOT (Number IN [1..MaxWorld]) THEN Number := 1;
      IF X1 > X2 THEN SwapWord(X1, X2);
      IF Y1 > Y2 THEN SwapWord(Y1, Y2);
      IF X2 = X1 THEN Inc(X2);
                                 { X2-X1 darf nicht 0 sein }
      IF Y2 = Y1 THEN Inc(Y2);
                                 { Y2-Y1 darf nicht 0 sein }
      FactorX[Number]         := Given.X/(X2-X1);
      FactorY[Number]         := Given.Y/(Y2-Y1);
      Worlds[Number].X1       := X1;
      Worlds[Number].Y1       := Y1;
      Worlds[Number].X2       := X2;
      Worlds[Number].Y2       := Y2;
      Worlds[Number].Clipping := Clip;
    END;
  END;

  PROCEDURE DefineWorldByType;
  BEGIN
    WITH WorldData DO
      DefineWorld(Number, X1, Y1, X2, Y2, Clipping);
  END;

  PROCEDURE SelectWorld;
    { gibt eine vordefinierte Welt zur Benutzung frei }
  BEGIN
    IF CalledGiven THEN BEGIN
      IF NOT (Number IN [1..MaxWorld]) THEN Number := 1;
      Selected := Number;
      Graph.SetViewPort(Worlds[Number].X1,Worlds[Number].Y1,
                        Worlds[Number].X2,Worlds[Number].Y2,
                        Worlds[Number].Clipping);
    END;
  END;

  PROCEDURE ResetWorlds;
   { löscht alle Welten, bzw. überschreibt die Koordinaten }
  BEGIN
    IF CalledGiven THEN BEGIN
      Selected := 1;
      FOR Loop := 1 TO MaxWorld DO
        DefineWorld(Loop, 0, 0, Given.X, Given.Y, TRUE);
    END;
  END;

  PROCEDURE Clear;
    { löscht den Inhalt einer gegebenen Welt }
  VAR
    SaveWorld : WORD;
  BEGIN
    IF CalledGiven THEN BEGIN
      IF NOT (Number IN [1..MaxWorld]) THEN Number := 1;
      SaveWorld := Selected;     { aktuelle Welt speichern }
      SelectWorld(Number);       { neue Welt auswählen     }
      ClearWorld;                { Weltinhalt löschen      }
      SelectWorld(SaveWorld);    { alte Welt setzen        }
    END;
  END;

  PROCEDURE ClearWorld;
    { löscht den Inhalt der aktuellen Welt }
  BEGIN
    IF CalledGiven THEN
      ClearViewPort;      { normale GRAPH-Routine benutzen }
  END;

  PROCEDURE AwakeWorld;
  { macht die "eingeschläferte"  Welt wieder aktiv }
  BEGIN
    IF CalledGiven THEN BEGIN
      DefineWorldByType(SleepNumber, SleepingWorld);
    END;
  END;

  PROCEDURE SleepWorld;
    { "schläfert" eine Welt ein }
  BEGIN
    IF CalledGiven THEN BEGIN
      SleepNumber := Selected;
      GetWorldData(SleepNumber, SleepingWorld);
      DefineWorld(SleepNumber, 0,0, GetMaxX, GetMaxY, TRUE);
    END;
  END;

  FUNCTION GetWorld;
    { gibt die aktuelle Welt zurück }
  BEGIN
    GetWorld := Selected;
  END;

  PROCEDURE GetGivenWorld;
  { liefert die Welt, die beim Programmieren benutzt wurde }
  BEGIN
    IF CalledGiven THEN BEGIN
      MaxX := Given.X;
      MaxY := Given.Y;
    END;
  END;

  PROCEDURE GetWorldData;
    { gibt die Weltdaten zurück }
  BEGIN
    IF CalledGiven THEN BEGIN
      IF NOT (Number IN [1..MaxWorld]) THEN Number := 1;
      WorldData.X1       := Worlds[Number].X1;
      WorldData.Y1       := Worlds[Number].Y1;
      WorldData.X2       := Worlds[Number].X2;
      WorldData.Y2       := Worlds[Number].Y2;
      WorldData.Clipping := Worlds[Number].Clipping;
    END;
  END;

  FUNCTION GetFactorX;
    { gibt den X-Faktor einer Welt zurück }
  BEGIN
    GetFactorX := FactorX[Number];
  END;

  FUNCTION GetFactorY;
    { gibt den Y-Faktor einer Welt zurück }
  BEGIN
    GetFactorY := FactorY[Number];
  END;

(* ---- die in GRAPH definierten Grafikbefehle ---------- *)

  PROCEDURE Arc;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
                        { Koordinaten und Radius berechnen }
      Radius := Round(Radius/FactorY[Selected]);
      Graph.Arc(X, Y, StAngle, EndAngle, Radius);
    END;
  END;

  PROCEDURE Bar;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      Graph.Bar(X1, Y1, X2, Y2);
    END;
  END;

  PROCEDURE Bar3D;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      Depth := Round(Depth/FactorY[Selected]);
      Graph.Bar3D(X1, Y1, X2, Y2, Depth, Top);
    END;
  END;

  PROCEDURE Circle;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Radius := Round(Radius/FactorY[Selected]);
      Graph.Circle(X, Y, Radius);
    END;
  END;

  PROCEDURE Ellipse;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      XRadius := Round(XRadius/FactorX[Selected]);
      YRadius := Round(YRadius/FactorY[Selected]);
      Graph.Ellipse(X, Y, StAngle, EndAngle,
                          XRadius, YRadius);
    END;
  END;

  PROCEDURE FloodFill;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Graph.FloodFill(X, Y, Border);
    END;
  END;

  PROCEDURE GetImage;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      Graph.GetImage(X1, Y1, X2, Y2, BitMap);
    END;
  END;

  FUNCTION GetPixel;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      GetPixel := Graph.GetPixel(X, Y);
    END;
  END;

  FUNCTION ImageSize;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      ImageSize := Graph.ImageSize(X1, Y1, X2, Y2);
    END;
  END;

  PROCEDURE Line;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      Graph.Line(X1, Y1, X2, Y2);
    END;
  END;

  PROCEDURE LineRel;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(DX, DY);
      Graph.LineRel(DX, DY);
    END;
  END;

  PROCEDURE LineTo;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Graph.LineTo(X, Y);
    END;
  END;

  PROCEDURE MoveRel;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(DX, DY);
      Graph.MoveRel(DX, DY);
    END;
  END;

  PROCEDURE MoveTo;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Graph.MoveTo(X, Y);
    END;
  END;

  PROCEDURE OutTextXY;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Graph.OutTextXY(X, Y, TextString);
    END;
  END;

  PROCEDURE PieSlice;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Radius := Round(Radius/FactorY[Selected]);
      Graph.PieSlice(X, Y, StAngle, EndAngle, Radius);
    END;
  END;

  PROCEDURE PutImage;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Graph.PutImage(X, Y, BitMap, BitBlt);
    END;
  END;

  PROCEDURE PutPixel;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcTwo(X, Y);
      Graph.PutPixel(X, Y, Pixel);
    END;
  END;

  PROCEDURE Rectangle;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      Graph.Rectangle(X1, Y1, X2, Y2);
    END;
  END;

  PROCEDURE SetViewPort;
  BEGIN
    IF CalledGiven THEN BEGIN
      CalcFour(X1, Y1, X2, Y2);
      Graph.SetViewPort(X1, Y1, X2, Y2, Clip);
    END;
  END;

BEGIN
  CalledGiven := FALSE;
  Selected    := 1;
  FactorX[1]  := 1.0;
  FactorY[1]  := 1.0;
END.
(* ------------------------------------------------------ *)
(*                 Ende von WORLD.PAS                     *)