Turbo Toolbox/Turbo_Toolbox.iso/1990/11/dtp/bezier.pas

Pascal/Delphi Source File | 1990-09-13 | 9KB | 288 lines

(* ------------------------------------------------------ *)
(*                       BEZIER.PAS                       *)
(*           Unit zum Zeichnen von Bézier-Kurven          *)
(*            anhand eines iterativen Verfahrens          *)
(*                  Turbo Pascal ab 5.0                   *)
(*          (c) 1990 Andreas Heinemann & TOOLBOX          *)
(* ------------------------------------------------------ *)

UNIT Bezier;

INTERFACE

USES Crt, Graph;

{DEFINE DEMO}                        { Schaltet Demo-Modus }

{$IFDEF DEMO}
VAR     { Demo-Modus: Die Geraden werden mit eingezeichnet }
  FarbeAlt: WORD;
  DemoLineColor: WORD;             { Farbe der Stützlinien }
CONST
  Verzoegerung = 50;          { Verzögerung für Demo-Modus }
{$ENDIF}

CONST
  BezMaxPoints     = 30;          { maximale Anzahl Punkte }
  BezMaxIt: WORD   = 3;                  { Iterationstiefe }
  BezMaxVirtPix    = 3200; { max. Anzahl virtueller Punkte }

TYPE
  BezRealTyp       = REAL;
                     { Koordinatenpaar in REAL-Darstellung }
  BezPoint         = RECORD
                       x, y : BezRealTyp;
                     END;
       { Typ für Startpunkt, Endpunkt und alle Stützpunkte }
  BezPoints        = ARRAY [1..BezMaxPoints] OF BezPoint;
                      { Array der Koordinaten aller Punkte }
  BezPointsPtr     = ^BezPoints;
                             { Pointer auf die Koordinaten }
  BezTempPointsDat = ARRAY [1..BezMaxPoints]
                     OF BezPointsPtr;
              { Array of Pointer auf die temporären Punkte }
  BezTempPointsPtr = ^BezTempPointsDat;
             { Pointer auf das Array der temporären Punkte }
  BezPixData       = ARRAY [1..BezMaxVirtPix] OF BezPoint;
          { Array der virtuellen Punkte für die Berechnung }
  BezPixDataPtr    = ^BezPixData;
             { Pointer auf das Array der virtuellen Punkte }
  BezPointProcTyp  = PROCEDURE(x, y : BezRealTyp);
  { Funktion zur Darstellung eines Punktes auf dem Monitor }

                    { Alle benötigten Daten und Prozeduren }
  BezDatRec = RECORD
    Punkte         : INTEGER;
    TempPoints     : BezTempPointsPtr;
    MaxIt          : WORD;
    MaxDX, MaxDY   : WORD;
    MaxDXY, MaxDYX : WORD;
    DLHoch2        : WORD;

    Half           : PROCEDURE(VAR p1,p2,h : BezPoint);
    SetPoint       : BezPointProcTyp;
                  { wird sofort nach Berechnung aufgerufen }
    SetFirstPoint  : BezPointProcTyp;
                 { erster Punkt,wird als erstes ausgeführt }
    SetLastPoint   : BezPointProcTyp;
                             { wird als letztes ausgeführt }
    DrawPoint      : BezPointProcTyp;
                     { wird aufgerufen, wenn keine weitere }
                             { Iteration durchgeführt wird }
    Iterate        : FUNCTION (It : WORD;
                               x, y : BezRealTyp) : BOOLEAN;
    LastPoint      : BezPoint;             { Letzter Punkt }
    UserData       : Pointer;   { für eigene Erweiterungen }
  END;

  BezDatPtr       = ^BezDatRec;
                   { Pointer auf die gesamte Datenstruktur }

VAR
  BezDat: BezDatPtr;               { gesamte Datenstruktur }

CONST
  BezPointMem = SizeOf(BezPoint);
    { für die Reservierung von Speicher auf dem Heap nötig }

PROCEDURE BezInitBezier(UPunkte : WORD);
{ initialisert Variablen und reserviert den nötigen
  Speicherplatz auf dem Heap }

PROCEDURE BezDisposeBezier;
{ räumt nach getaner Arbeit den Heap wieder auf }

PROCEDURE BezDoBeziere;
{ Aufruf der Bezierberechnung }

IMPLEMENTATION

PROCEDURE BezHalf(VAR p1, p2, h : BezPoint);
{ teilt die Strecke zwischen den Koordinatenpaaren p1 und
  p2 und gibt den Mittelpunkt in h zurück }
BEGIN
{$IFDEF DEMO}
  FarbeAlt:=GetColor;
  SetColor(DemoLineColor);
  Line(Round(p1.x), Round(p1.y), Round(p2.x), Round(p2.y));
  SetColor(FarbeAlt);
  Delay(Verzoegerung);
{$ENDIF}
  h.x:=(p1.x + p2.x) * 0.5;
  h.y:=(p1.y + p2.y) * 0.5;
END;

PROCEDURE BezSetPoint(x, y : BezRealTyp);   { Punkt setzen }
BEGIN
  PutPixel(Round(x), Round(y), GetColor);
END;

FUNCTION BezIterate(It : WORD;
                    x, y : BezRealTyp) : BOOLEAN;
{ liefert TRUE, wenn Iterationstiefe noch nicht
  erreicht ist, ansonsten FALSE }
BEGIN
  WITH BezDat^ DO
    IF It <= MaxIt THEN
      Bezier.BezIterate := TRUE
    ELSE
      Bezier.BezIterate := FALSE;
END;

FUNCTION BezIterateDist(It : WORD;
                        x, y : BezRealTyp) : BOOLEAN;
{ optimierte Abbruchbedingung: Berechnung abbrechen,
  wenn weitere Iterationen keine sichtbare Verbesserung
  der Bezièrkurve bewirken }
VAR
  f        : BOOLEAN;
  ddx, ddy : WORD;
BEGIN
  f := TRUE;
  WITH BezDat^ DO BEGIN
    IF It >= MaxIt THEN
      f := FALSE
    ELSE
    BEGIN            { Abstand zum letzten Punkt ermitteln }
      ddx := Abs(Round(LastPoint.x - x));
      ddy := Abs(Round(LastPoint.y - y));
                             { nah genug am letzten Punkt? }
      IF Sqr(ddx) + Sqr(ddy) < DLHoch2 THEN
        f := FALSE
      ELSE                { lange gerade Strecken abfangen }
        IF (((ddx < MaxDX) AND (ddy < MaxDXY)) OR
            ((ddy < MaxDY) AND (ddx < MaxDYX))) THEN
          f := FALSE;
    END;
  END;
  BezIterateDist := f;
END;

PROCEDURE BezDrawPoint(x, y : BezRealTyp);  { Linie ziehen }
BEGIN
  LineTo(Round(x),Round(y));
  WITH BezDat^ DO BEGIN
    LastPoint.x := x;
    LastPoint.y := y;
  END;
END;

PROCEDURE BezSetFirstPoint(x, y : BezRealTyp);
                                       { Startpunkt setzen }
BEGIN
  MoveTo(Round(x), Round(y));
  WITH BezDat^ DO BEGIN
    LastPoint.x := x;
    LastPoint.y := y;
  END;
END;

PROCEDURE BezSetLastPoint(x, y : BezRealTyp);
                               { Linie zum Endpunkt ziehen }
BEGIN
  LineTo(Round(x), Round(y));
END;

PROCEDURE BezInitBezier(UPunkte : WORD);
VAR
  i : INTEGER;
BEGIN
  New(BezDat);
  WITH BezDat^ DO BEGIN
    Punkte := UPunkte;               { Anzahl aller Punkte }
    New(TempPoints);
          { Speicherplatz für temporäre Punkte reservieren }
    FOR i := 1 TO Punkte DO
      GetMem(TempPoints^[i], (Punkte-i+1) * BezPointMem);
    MaxIt   := BezMaxIt;
    MaxDX   := 10;                   { Konstante Werte für }
    MaxDY   := 5;                    { die Ermittlung der  }
    MaxDXY  := 5;                    { Abbruchbedingung    }
    MaxDYX  := 2;
    DLHoch2 := 100;       { Abstand^2 für Abbruchbedingung }

    UserData := NIL;        { reserviert für Benutzerdaten }

    Half          := BezHalf;          { hier kann der     }
    SetPoint      := BezSetPoint;      { Anwender eigene   }
    DrawPoint     := BezDrawPoint;     { Funktionen statt  }
    SetFirstPoint := BezSetFirstPoint; { der vorgegebenen  }
    SetLastPoint  := BezSetLastPoint;  { implementieren    }
    Iterate       := BezIterateDist;
  END;
END;

PROCEDURE BezDisposeBezier;
{ Heap-Speicher nach der Berechnung wieder freigeben }
VAR
  i : INTEGER;
BEGIN
  WITH BezDat^ DO BEGIN
    FOR i := 1 TO Punkte DO
      FreeMem(TempPoints^[i], (Punkte-i+1) * BezPointMem);
      Dispose(TempPoints);
  END;
  Dispose(BezDat);
END;

PROCEDURE BezComputeBezier(It : WORD);
{ rekursive Berechnung der Bezièrkurven; in it
  wird die Anzahl der Iterationen übergeben }
VAR i, j        : INTEGER;
    SparePoints : BezPoints;
    x, y        : BezRealTyp;
BEGIN
  WITH BezDat^ DO BEGIN
    FOR i := 2 TO Punkte DO              { Strecken teilen }
      FOR j := 1 TO Punkte - i + 1 DO
        Half(TempPoints^[i-1]^[j], TempPoints^[i-1]^[j+1],
             TempPoints^[i]^[j]);
    x := TempPoints^[Punkte]^[1].x;
    y := TempPoints^[Punkte]^[1].y;
    IF @SetPoint <> NIL THEN
      SetPoint(x, y);
                         { 2. Iterationsstützpunkte merken }
    FOR i := 1 TO Punkte DO
    BEGIN
      TempPoints^[1]^[i] := TempPoints^[i]^[1];
      SparePoints[Punkte-i+1] :=
        TempPoints^[i]^[Punkte-i+1];
    END;
    Inc(It);                    { Iterationszähler erhöhen }
    IF Iterate(It, x, y) THEN BEGIN
                                { weitere Berechnung nötig }
      BezComputeBezier(It);            { rekursiver Aufruf }
      FOR i := 1 TO Punkte DO
        TempPoints^[1]^[i] := SparePoints[i];
      BezComputeBezier(It);
    END
    ELSE BEGIN
      FOR i := 2 TO Punkte DO
        DrawPoint(TempPoints^[i]^[j].x,
                  TempPoints^[i]^[j].y);
      { bereits berechnete StützPunkte liegen näher an der
         Bézier-Kurve als die Gerade vom letzten Punkt zum
                                     aktuellen Punkt (x,y) }
      FOR i := 2 TO Punkte - 1 DO
        DrawPoint(SparePoints[i].x,SparePoints[i].y);
    END;
  END;
END;

PROCEDURE BezDoBeziere;
VAR
  LastPointSet : BezPoint;
BEGIN
  WITH BezDat^ DO BEGIN
    LastPointSet := BezDat^.TempPoints^[1]^[Punkte];
    IF @SetFirstPoint <> NIL THEN
      SetFirstPoint(TempPoints^[1]^[1].x,
                    TempPoints^[1]^[1].y);
      BezComputeBezier(0);
      IF @SetLastPoint <> NIL THEN
        SetLastPoint(LastPointSet.x, LastPointSet.y);
  END;
END;

END.