Script 3d Kugelpilz

PROCEDURE pilz;

{{$DEBUG}





(* --------------------------------------------------------------------------------------------------------------------



sebastian gmelin - nds caad 04/05 - ethz



Kugelpilz 3d


-------------------------------------------------------------------------------------------------------------------- *) 

TYPE

  UmrissData = STRUCTURE

    SegmentWinkel : REAL;

    KreisPunkt : VECTOR;

    KreispunktLinks, KreispunktRechts : VECTOR;

    RundungsPunkt, GegenRundungsPunkt : VECTOR;

    RundungsRadius, GegenRundungsRadius : REAL;

    Zerfall : BOOLEAN;

  END;



VAR

  i, k, l, m : INTEGER; {Zählervariablen}

  Hilfsobjekte, Umrissobjekte : DYNARRAY[] OF HANDLE;

  Hilfsobjektzaehler, UmrissObjekteZaehler  : LONGINT;

  Umriss : DYNARRAY[] OF UmrissData;

  UmrissObjekt : HANDLE;







  {Benutzervariablen}

  Radius : REAL;   {ca. Radius des Pilzes in eingestellten Einheiten}

  x, y : REAL;   {Mittelpunkt}



  Lamellen : INTEGER;  {Anzahl der Lamellen}

  Lamellendicke, LamellenDickeMin : REAL;   {Dicke einer einzelnen Lamelle}

  Lamellenunterteilung : INTEGER;  {Anzahl der Polygonunterteilungen einer Lamelle (Weichheit der Form)}

  Lamellenschichten : INTEGER;  {Anzahl der LAmellenschichten}

  Lamellenverkleinerung : REAL;   {Größe der letzten Lamellenschicht im Verhältnis zur ersten in Prozent}



  Unterteilungen : INTEGER;  {Summe Einschnürungen und Zerfall}

  Zerfall : INTEGER;  {Beschädigungen an den Einschnürungen}

  ZerfallsWinkel_min : REAL;

  Zerfallswinkel_max : REAL;   {Einschränkungen}

  Kreisverschiebung : REAL;   {radiale Punktverschiebung, prozentual zum Radius}

  Kruemmung : REAL;   {Krümmung der Einzelsegmente, prozentual}

  Kruemmungsart : INTEGER;  {0 - Corner, 1 - Bezier, 2 - Cubic, 3 - Arc}

  Kruemmungsvarianz : INTEGER;  {Zufallsgewichtung der Krümmung in Prozent}

  Ausrundung : INTEGER;  {Radius der Ausrundungen prozentual zu Krümmungsradien}

  Ausrundungsart : INTEGER;  {0 - Corner, 1 - Bezier, 2 - Cubic, 3 - Arc}



  Risstiefe : INTEGER;  {maximale Risstiefe prozentual zum Gesamtradius}

  Rissvarianz : INTEGER;  {prozentuale Zufallsgewichtung: 100 sehr zufällig 0 kein Zufall}

  Rissausrundung : INTEGER;  {Ausrundung prozentual zur maximal möglichen Ausrundung}

  Rissausrundungsvarianz : INTEGER;  {prozentuale Zufallsgewichtung: 100 sehr zufällig 0 kein Zufall}

  Ausrundungsverhaeltnis : INTEGER;  {Verhältnis prozentual ausgerundet (0) oder scharfe Scheitelkante (100)}

  Verlauffarbe : ARRAY[1..2,1..3] OF INTEGER; {Start- und Endwert des Verlaufs in RGB}

  Verlaufslaenge : INTEGER;









{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE Hilfskonstruktion;



BEGIN

  {Layer('Hilfskonstruktion');}

  PenFore(256*180, 256*180, 256*180);

  PenSize(1);

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE Konstruktion;



BEGIN

  {Layer('Konstruktion');}

  PenFore(0, 0, 0);

  PenSize(40);

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE ObjektzuHilfsliste(_LObj : HANDLE);



BEGIN

  HilfsobjektZaehler := HilfsobjektZaehler + 1;

  ALLOCATE HilfsObjekte[1..HilfsobjektZaehler];

  HilfsObjekte[HilfsobjektZaehler] := _LObj;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE ObjektzuUmrissliste(_LObj : HANDLE);



BEGIN

  UmrissObjekteZaehler := UmrissObjekteZaehler + 1;

  ALLOCATE UmrissObjekte[1..UmrissObjekteZaehler];

  UmrissObjekte[UmrissObjekteZaehler] := _LObj;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE AussenKreis (_radius : REAL);



BEGIN

  Hilfskonstruktion;

  {PenFore(256*255, 0, 0);}

  OVAL(0 - _radius, 0 - _radius, 0 + _radius, 0 + _radius);

  ObjektzuHilfsliste(LNewObj);

END;



{--------------------------------------------------------------------------------------------------------------}  

procedure LinksRechts (_zaehler, _Unterteilungen : INTEGER; VAR _links, _rechts : INTEGER);



BEGIN

  _Links  := _zaehler + 1;

  _Rechts := _zaehler - 1;

  IF _Links  > _Unterteilungen THEN _Links := 1;

  IF _Rechts < 1 THEN _Rechts := _Unterteilungen;

END;



{--------------------------------------------------------------------------------------------------------------}  

FUNCTION KreisRadius (A, B, C : VECTOR) : REAL;



VAR

  _Senkrechte1, _Senkrechte2 : VECTOR;

  _Linie : ARRAY[1..2,1..2] OF POINT;

  _Schnittpunkt : POINT;

  _parallel, _intOnLines : BOOLEAN;



BEGIN

  _Senkrechte1 := A + Perp(B - A);

  _Senkrechte2 := C + Perp(B - C);



  _Linie[1,1].x := A.x;

  _Linie[1,1].y := A.y;

  _Linie[2,1].x := C.x;

  _Linie[2,1].y := C.y;

  _Linie[1,2].x := _Senkrechte1.x;

  _Linie[1,2].y := _Senkrechte1.y;

  _Linie[2,2].x := _Senkrechte2.x;

  _Linie[2,2].y := _Senkrechte2.y;



  LineLineIntersection(_Linie[1,1], _Linie[1,2], _Linie[2,1], _Linie[2,2], _parallel, _intOnLines, _SchnittPunkt);

  KreisRadius := SQRT(SQR(A.x-_SchnittPunkt.x) + SQR(A.y-_SchnittPunkt.y));

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE Unterteilen (_Unterteilungen : INTEGER);



VAR 

  a, b, _rechts, _links : INTEGER;

  _min, _max, _ok : BOOLEAN;

  _Durchlauf : LONGINT;

  _Abweichung, _Winkel : REAL;

  _Notbremse : INTEGER;



BEGIN

  _min := FALSE;

  _max := FALSE;



  _Durchlauf := 0;



  FOR a := 1 TO _Unterteilungen DO BEGIN

    Umriss[a].SegmentWinkel := 360 * a / _Unterteilungen;

  END;



  REPEAT

    FOR a := 1 TO _Unterteilungen DO BEGIN



      LinksRechts (a, Unterteilungen, _links, _rechts);

      

      _Winkel := Umriss[_links].SegmentWinkel - Umriss[_rechts].SegmentWinkel;

      IF _Winkel < 0 THEN _Winkel := _Winkel + 360;

      

      _ok := FALSE;

      _Notbremse := 0;



      REPEAT

        _Abweichung := RANDOM * _Winkel;

        IF _Abweichung >= Zerfallswinkel_min THEN BEGIN

          IF _Abweichung <= Zerfallswinkel_max THEN BEGIN

            IF _Winkel - _Abweichung >= Zerfallswinkel_min THEN BEGIN

              IF _Winkel - _Abweichung <= Zerfallswinkel_max THEN BEGIN

                _ok := TRUE;

              END;

            END;

          END;

        END;

      _Notbremse := _Notbremse + 1;

      UNTIL ((_ok = TRUE) OR (_Notbremse > 50));



      IF _Notbremse <= 50 THEN Umriss[a].SegmentWinkel := Umriss[_rechts].SegmentWinkel + _Abweichung;

      IF Umriss[a].SegmentWinkel < 0   THEN Umriss[a].SegmentWinkel := Umriss[a].SegmentWinkel + 360;

      IF Umriss[a].SegmentWinkel > 360 THEN Umriss[a].SegmentWinkel := Umriss[a].SegmentWinkel - 360;



      IF _Abweichung <= Zerfallswinkel_min * 1.15 THEN _min := TRUE;

      IF _Abweichung >= Zerfallswinkel_max * 0.85 THEN _max := TRUE;

      

    END;

    _Durchlauf := _Durchlauf + 1;

  UNTIL (((_min=TRUE) AND (_max=TRUE)) OR (_Durchlauf > 100));



  {array zur Sicherheit sortieren}

  SortArray(Umriss, _Unterteilungen, 1);



  FOR a := 1 TO _Unterteilungen DO BEGIN

    Umriss[a].Kreispunkt := Ang2Vec(Umriss[a].SegmentWinkel,Radius);

  END;



END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE ZerfallPositionen (_Unterteilungen, _Zerfall : INTEGER);



VAR 

  a, b, _rechts, _links : INTEGER;

  

BEGIN

  FOR a := 1 TO _Unterteilungen DO BEGIN

    Umriss[a].Zerfall := false;

  END;



  FOR a := 1 TO _Zerfall DO BEGIN

    REPEAT

      b := 1+(Random * _Unterteilungen-1);

      IF b<1 THEN b:=1;

      IF b>_Unterteilungen THEN b:= _Unterteilungen;

      LinksRechts (b, _Unterteilungen, _links, _rechts);

    UNTIL (Umriss[_links].Zerfall = false) AND (Umriss[_rechts].Zerfall = false);

    Umriss[b].Zerfall := true;

  END;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE KreispunkteVerschieben(_Unterteilungen : INTEGER);



VAR 

    a, b, _links, _rechts : INTEGER;



BEGIN

  FOR a := 1 TO _Unterteilungen DO BEGIN

    LinksRechts (a, Unterteilungen, _links, _rechts);

    Umriss[a].Kreispunkt := Umriss[a].Kreispunkt + Umriss[a].Kreispunkt * (RANDOM-0.5) * Kreisverschiebung/100;

  END;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE KreispunkteSplitten(_Unterteilungen : INTEGER);



VAR 

    a, b, _links, _rechts : INTEGER;

  Laenge1, Laenge2 : REAL;

  _Hilfsvektor : VECTOR;



BEGIN

  FOR a := 1 TO _Unterteilungen DO BEGIN

    LinksRechts (a, Unterteilungen, _links, _rechts);



    Laenge1 := Norm(Umriss[_links].Kreispunkt - Umriss[a].Kreispunkt);

    Laenge2 := Norm(Umriss[_rechts].Kreispunkt - Umriss[a].Kreispunkt);

    IF Laenge2 < Laenge1 THEN Laenge1 := Laenge2;



    _Hilfsvektor := UnitVec(Umriss[_links].Kreispunkt - Umriss[a].Kreispunkt) * Laenge1 * Ausrundung/400;

    Umriss[a].KreispunktLinks := Umriss[a].Kreispunkt + _Hilfsvektor;

    _Hilfsvektor := UnitVec(Umriss[_rechts].Kreispunkt - Umriss[a].Kreispunkt) * Laenge1 * Ausrundung/400;

    Umriss[a].KreispunktRechts := Umriss[a].Kreispunkt + _Hilfsvektor;

  END;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE RundungsPunkteErstellen(_Unterteilungen : INTEGER);



VAR 

    a, b, _links, _rechts : INTEGER;

  _Hilfsvektor : VECTOR;

  _Zufall : REAL;



BEGIN

  FOR a := 1 TO _Unterteilungen DO BEGIN

    LinksRechts (a, Unterteilungen, _links, _rechts);

    _HilfsVektor := (Umriss[_links].KreisPunktRechts - Umriss[a].KreispunktLinks);

    Umriss[a].RundungsPunkt := (Umriss[a].KreispunktLinks + 0.5 * _HilfsVektor);

    IF Umriss[a].Zerfall = False THEN BEGIN

      Umriss[a].RundungsPunkt := Umriss[a].RundungsPunkt + UnitVec(Perp(_Hilfsvektor)) * (1 + RANDOM * Kruemmungsvarianz/100) * NORM(_HilfsVektor) * Kruemmung/100;

      Umriss[a].RundungsRadius := KreisRadius(Umriss[a].KreispunktLinks, Umriss[a].RundungsPunkt, Umriss[_links].KreispunktRechts);

    END ELSE BEGIN

      Umriss[a].RundungsPunkt := Umriss[a].RundungsPunkt - UnitVec(Umriss[a].Rundungspunkt) * Radius * (Risstiefe-RANDOM*(Risstiefe * Rissvarianz/100)) / 100;

      Umriss[a].RundungsRadius := KreisRadius(Umriss[a].KreispunktLinks, Umriss[a].RundungsPunkt, Umriss[_links].KreispunktRechts);

      Umriss[a].RundungsRadius := Umriss[a].RundungsRadius * (Rissausrundung - RANDOM*(Rissausrundung * Rissausrundungsvarianz /100))/100;

      _Zufall := RANDOM;

      IF _Zufall <= Ausrundungsverhaeltnis/100 THEN Umriss[a].RundungsRadius := 0.1;

      Umriss[a].KreispunktLinks := Umriss[a].Kreispunkt + UnitVec(Umriss[a].RundungsPunkt - Umriss[a].Kreispunkt) * Norm(Umriss[a].Kreispunkt - Umriss[a].KreispunktRechts);

      Umriss[_links].KreispunktRechts := Umriss[_links].Kreispunkt + UnitVec(Umriss[a].RundungsPunkt - Umriss[_links].Kreispunkt) * Norm(Umriss[_links].KreispunktRechts - Umriss[_links].Kreispunkt);

    END;    

  END;

END;



{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE GegenRundungsPunkteErstellen(_Unterteilungen : INTEGER);



VAR 

    a, b, _links, _rechts : INTEGER;

  _Linie : ARRAY[1..2,1..2] OF POINT;

  _Schnittpunkt : POINT;

  _parallel, _intOnLines : BOOLEAN;



BEGIN

  FOR a := 1 TO _Unterteilungen DO BEGIN

    LinksRechts (a, Unterteilungen, _links, _rechts);

    {Gegenrundungspunkt ist der Schnittpunkt der Geraden Rundungspunkt[a]-KreispunktLinks und RundungsPunkt[rechts]-KreispunkteRechts}

    _Linie[1,1].x := Umriss[a].RundungsPunkt.x;

    _Linie[1,1].y := Umriss[a].RundungsPunkt.y;

    _Linie[1,2].x := Umriss[a].KreispunktLinks.x;

    _Linie[1,2].y := Umriss[a].KreispunktLinks.y;

    _Linie[2,1].x := Umriss[_rechts].RundungsPunkt.x;

    _Linie[2,1].y := Umriss[_rechts].RundungsPunkt.y;

    _Linie[2,2].x := Umriss[a].KreispunktRechts.x;

    _Linie[2,2].y := Umriss[a].KreispunktRechts.y;



    LineLineIntersection(_Linie[1,1], _Linie[1,2], _Linie[2,1], _Linie[2,2], _parallel, _intOnLines, _SchnittPunkt);

    Umriss[a].GegenRundungsPunkt.x := _Schnittpunkt.x;

    Umriss[a].GegenRundungsPunkt.y := _Schnittpunkt.y;

    Umriss[a].GegenRundungsRadius := KreisRadius(Umriss[a].KreispunktRechts, Umriss[a].GegenRundungsPunkt, Umriss[a].KreispunktLinks);

  END;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE Ausrunden;



VAR 

    a, b, _links, _rechts : INTEGER;

  _aussen : BOOLEAN;  

  _VertexType : INTEGER;

  _x, _y, _Radius : REAL;

  



BEGIN

  b:=1;

  _aussen := false;

  FOR a := 1 TO GetVertNum(UmrissObjekt) DO BEGIN

    GetPolylineVertex(UmrissObjekt, a, _x, _y, _VertexType, _Radius);

    IF _VertexType = 3 THEN BEGIN

      

        IF _aussen = True THEN BEGIN

          IF Umriss[b].Zerfall = FALSE THEN BEGIN

            SetPolylineVertex(UmrissObjekt, a, _x, _y, Kruemmungsart, _Radius, True);

          END;

          b := b + 1;

          _aussen := False;

        END ELSE BEGIN

          SetPolylineVertex(UmrissObjekt, a, _x, _y, Ausrundungsart, _Radius, True);

          _aussen := True;

        END;  

      

    END;

  END;

END;



{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE Fuellen;



VAR

  gradientName, objectName:STRING;

  result, segmentIndex:INTEGER;

  gradientHandle, objectHandle, layerHandle, viewportHandle:HANDLE;

  gradientName1:STRING;



BEGIN

  {Gradient Definition Entries}

  gradientName := 'Gradient-1';

  gradientHandle:= CreateGradient (gradientName);

  gradientName1 := GetName(gradientHandle);

  segmentIndex := 1;

  SetGradientData (gradientHandle,segmentIndex,0,0.5,Verlauffarbe[1,1],Verlauffarbe[1,2],Verlauffarbe[1,3]);

  segmentIndex := 2;

  SetGradientData (gradientHandle,segmentIndex,1,0.5,Verlauffarbe[2,1],Verlauffarbe[2,2],Verlauffarbe[2,3]);

  {End of GradientDefinition Entries}

  

  DSelectAll;

  SetSelect(UmrissObjekt);

  { Set gradient fill style }

  result := Name2Index(gradientName1);

  SetObjectVariableLongInt  (UmrissObjekt,695,result * -1);       {Fillstyle -> GBradient}

  SetObjectVariableReal     (UmrissObjekt,74,0);                  {Gradient-Angle}

  SetObjectVariableReal     (UmrissObjekt,70,0);                  {X-Offset}

  SetObjectVariableReal     (UmrissObjekt,71,0);                  {Y-Offset}

  SetObjectVariableReal     (UmrissObjekt,72,Verlaufslaenge*10);  {Länge}

  SetObjectVariableBool     (UmrissObjekt,75,FALSE);              {Fill - Repeat}

  SetObjectVariableBool     (UmrissObjekt,76,FALSE);              {Fill - Mirror}

  SetObjectVariableLongInt  (UmrissObjekt,78,2);                  {Verlaufstyp}

END;





{--------------------------------------------------------------------------------------------------------------}  

FUNCTION Umrisslinie (_Unterteilungen : INTEGER; _scale, _Verzerrung : REAL) : HANDLE;



VAR

  a, b, _links, _rechts : INTEGER;



BEGIN

  DSelectAll;



  Smooth(0);  

  ClosePoly;



  BeginPoly;

  FOR a := 1 TO _Unterteilungen DO BEGIN

    LinksRechts (a, Unterteilungen, _links, _rechts);

    AddPoint (Umriss[a].KreispunktRechts.x, Umriss[a].KreispunktRechts.y); 

    ArcTo (Umriss[a].GegenRundungsPunkt.x, Umriss[a].GegenRundungsPunkt.y, Umriss[a].GegenRundungsRadius);

    AddPoint (Umriss[a].KreispunktLinks.x, Umriss[a].KreispunktLinks.y);

    ArcTo (Umriss[a].RundungsPunkt.x, Umriss[a].RundungsPunkt.y, Umriss[a].RundungsRadius); 

  END;

  EndPoly;



  Scale(_scale * _Verzerrung, _scale);

  UmrissObjekt := LNewObj;

  Ausrunden;



  UmrissLinie := LNewObj;

END;



{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE LamelleZeichnen (_Unterteilungen, _SegmentSchichten, _Schicht : INTEGER; _Verzerrfaktor : REAL; VAR _Lamelle : HANDLE);



CONST 

  _Endwinkel = 88;



VAR 

    a, b, _links, _rechts : INTEGER;

  _object : DYNARRAY[] OF HANDLE;

  _scale : DYNARRAY[] OF REAL;

  _scaleMax : REAL;

  _Deckel, _Mitte, _Boden, _temp : HANDLE;

  _error : INTEGER;

  _StartWinkel, _SchrittWinkel : REAL;



BEGIN



  ALLOCATE _object [1.._SegmentSchichten*2+2];

  ALLOCATE _scale [1.._SegmentSchichten];



  _scale[1] := 1;

  FOR a := 2 TO _SegmentSchichten DO BEGIN

    _scale[a] := _scale[a-1] + cos(DEG2RAD((a)*_Endwinkel/_SegmentSchichten));

  END;

  _scaleMax := _scale[_SegmentSchichten];



  BeginMXtrd(-1 * LamellenDicke/2, -1 * LamellenDickeMin/2);

    Locus(0,0);

    _object[1] := UmrissLinie(_Unterteilungen, _scale[1]/_scaleMax, _Verzerrfaktor);

    FOR a := 2 TO _SegmentSchichten DO BEGIN

      DSelectAll;

      _object[a] := HDuplicate(_object[1] , 0, 0);

      SetSelect(_object[a]);

      Scale(_scale[a], _scale[a]);

    END;

  EndMXtrd;

  _Boden := LNewObj;



  

  BeginMXtrd(-1 * LamellenDickeMin/2, LamellenDickeMin/2);

    _object[_SegmentSchichten*2+1] := UmrissLinie(_Unterteilungen, 1, _Verzerrfaktor);

    _object[_SegmentSchichten*2+2] := HDuplicate(_object[_SegmentSchichten*2+1] , 0, 0);

  EndMXtrd;

  _Mitte := LNewObj;



  BeginMXtrd(LamellenDicke/2, LamellenDickeMin/2);

    Locus(0,0);

    _object[_SegmentSchichten+1] := UmrissLinie(_Unterteilungen, _scale[1]/_scaleMax, _Verzerrfaktor);

    FOR a := 2 + _SegmentSchichten TO _SegmentSchichten*2 DO BEGIN

      DSelectAll;

      _object[a] := HDuplicate(_object[_SegmentSchichten + 1] , 0, 0);

      SetSelect(_object[a]);

      Scale(_scale[a-_SegmentSchichten], _scale[a-_SegmentSchichten]);

    END;

  EndMXtrd;

  _Deckel := LNewObj;



  _error := AddSolid(_Boden, _Mitte, _temp);

  _error := AddSolid(_temp, _Deckel, _Lamelle);



  case _Schicht of

    1 : _StartWinkel := 0;

    2 : _StartWinkel := 0.5 * 180/Lamellen;

    3 : _StartWinkel := 0.25 * 180/Lamellen;

    4 : _StartWinkel := 0.125 * 180/Lamellen;

  END;



  case _Schicht of

    1 : _SchrittWinkel := 180/Lamellen;

    2 : _SchrittWinkel := 180/Lamellen;

    3 : _SchrittWinkel :=  90/Lamellen;

    4 : _SchrittWinkel :=  45/Lamellen;

  END;

  

  Set3DRot(_lamelle, _StartWinkel + L*_SchrittWinkel, 0, 0, 0, 0, 0);

  DSelectAll;

END;



{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE HilfsRundungsKreise (_Punkt1, _Punkt2, _Punkt3 : VECTOR; _Radius, _Radius1, _Radius2 : REAL);




VAR 

  _VecLinks, _VecRechts : VECTOR;

  _MittelSenkrechte, _Tangente : VECTOR;

  _Winkel, _laenge : REAL;





BEGIN

  _VecLinks := _Punkt1 - _Punkt2;

  _VecRechts := _Punkt3 - _Punkt2;

  _Winkel := (180 - AngBVec(_VecLinks, _VecRechts)) / 2;

  IF _Winkel <> 90 THEN BEGIN

    _laenge := _Radius / COS(Deg2Rad(_Winkel));

    _MittelSenkrechte := _Punkt2 + UnitVec(UnitVec(_VecLinks) + UnitVec(_VecRechts)) * _laenge;

  

    MoveTo(_Punkt2.x, _Punkt2.y);

    LineTo(_MittelSenkrechte.x, _MittelSenkrechte.y);

    ObjektzuHilfsliste(LNewObj); 

  

    MoveTo(_MittelSenkrechte.x, _MittelSenkrechte.y);

    LineTo(_Punkt1.x, _Punkt1.y);

    ObjektzuHilfsliste(LNewObj); 

    

    MoveTo(_MittelSenkrechte.x, _MittelSenkrechte.y);

    LineTo(_Punkt3.x, _Punkt3.y);

    ObjektzuHilfsliste(LNewObj); 



    IF _Radius > 0 THEN BEGIN 

      oval(_MittelSenkrechte.x - _Radius, _MittelSenkrechte.y - _Radius, _MittelSenkrechte.x + _Radius, _MittelSenkrechte.y + _Radius);

      ObjektzuHilfsliste(LNewObj); 

    END;

  

    IF _Radius1 > 0 THEN BEGIN

      oval(_MittelSenkrechte.x - _Radius1, _MittelSenkrechte.y - _Radius1, _MittelSenkrechte.x + _Radius1, _MittelSenkrechte.y + _Radius1);

      ObjektzuHilfsliste(LNewObj);

    END;

  

    IF _Radius2 > 0 THEN BEGIN

      oval(_MittelSenkrechte.x - _Radius2, _MittelSenkrechte.y - _Radius2, _MittelSenkrechte.x + _Radius2, _MittelSenkrechte.y + _Radius2);

      ObjektzuHilfsliste(LNewObj);

    END;

  END;

END;





{--------------------------------------------------------------------------------------------------------------}  

PROCEDURE HilfsKonstruktionZeichnen (_Unterteilungen : INTEGER);



VAR 

    a, _links, _rechts, _VertexType : INTEGER;

  _x, _y, _arcRadius, _arcRadius2 : REAL;

  _VecLinks, _VecRechts : VECTOR;

  _MittelSenkrechte, _Tangente : VECTOR;

  _Winkel, _laenge : REAL;



BEGIN



  Hilfskonstruktion;

  FOR a := 1 TO _Unterteilungen DO BEGIN

    LinksRechts (a, Unterteilungen, _links, _rechts);

    MoveTo (0,0);

    LineTo (Umriss[a].KreispunktLinks.x, Umriss[a].KreispunktLinks.y);

    ObjektzuHilfsliste(LNewObj);

    MoveTo (0,0);

    LineTo (Umriss[a].KreispunktRechts.x, Umriss[a].KreispunktRechts.y);

    ObjektzuHilfsliste(LNewObj);

    MoveTo (0,0);

    LineTo (Umriss[a].RundungsPunkt.x, Umriss[a].RundungsPunkt.y);

    ObjektzuHilfsliste(LNewObj); 



    HilfsRundungsKreise (Umriss[a].KreispunktLinks, Umriss[a].RundungsPunkt, Umriss[_links].KreispunktRechts, Umriss[a].RundungsRadius, Umriss[a].GegenRundungsRadius + Umriss[a].RundungsRadius, Umriss[_links].GegenRundungsRadius + Umriss[a].RundungsRadius);

    HilfsRundungsKreise (Umriss[a].KreispunktRechts, Umriss[a].GegenRundungsPunkt, Umriss[a].KreispunktLinks, Umriss[a].GegenRundungsRadius, 0, 0);



    AussenKreis(Radius);

  END;

END;





{--------------------------------------------------------------------------------------------------------------}

{--------------------------------------------------------------------------------------------------------------}

BEGIN

  

  {Benutzervariablen}

  Radius := 100; {Eingabe in eingestellten Einheiten}



  Lamellen := 4;

  Lamellendicke := 12;

  LamellenDickeMin := 1;

  Lamellenunterteilung := 8;

  Lamellenschichten := 4;

  Lamellenverkleinerung := 80;



  Unterteilungen := 15; {Eingabe von 1 bis 100}

  Zerfallswinkel_max := 60; {größter   radialer Unterteilungswinkel in Grad}

  Zerfallswinkel_min := 2; {kleinster radialer Unterteilungswinkel in Grad}

  Kreisverschiebung := 10; {radiale Verschiebung der Unterteilungspunkte, prozentual zu Winkel}

  Kruemmung := 20; {prozentuale Kruemmung (100% = 0.5 Laenge der Verbindungsgeraden zweier Punkte)}

  Kruemmungsvarianz := 40; {Zufallsgewichtung der Krümmung in Peozent}

  Kruemmungsart := 1; {0 - Corner, 1 - Bezier, 2 - Cubic, 3 - Arc}

  Ausrundungsart := 1; {0 - Corner, 1 - Bezier, 2 - Cubic, 3 - Arc}

  Ausrundung := 100; {Ausrundung prozentual zu Krümmungsradien}



  Zerfall := 5; {Anzahl von Einrissen}

  Risstiefe := 80; {maximale Risstiefe prozentual zum Gesamtradius}

  Rissvarianz := 80; {prozentuale Zufallsgewichtung: 100 sehr zufällig 0 kein Zufall}

  Rissausrundung := 50; {Ausrundung prozentual zur maximal möglichen Ausrundung}

  Rissausrundungsvarianz := 50; {prozentuale Zufallsgewichtung: 100 sehr zufällig 0 kein Zufall}

  Ausrundungsverhaeltnis := 30; {Verhältnis prozentual: ausgerundet (0) oder scharfe Scheitelkante (100)}



  Verlauffarbe[1,1] := 50;

  Verlauffarbe[1,2] := 50;

  Verlauffarbe[1,3] := 50;



  {Variablen}

  IF Unterteilungen > 100 THEN Unterteilungen := 100;

  IF Zerfall > Unterteilungen / 2 THEN Zerfall := Unterteilungen / 2;                 

  IF Zerfallswinkel_min * Unterteilungen > 360 THEN Zerfallswinkel_min := 360 / (Unterteilungen+1);

  IF Zerfallswinkel_max * Unterteilungen < 360 THEN Zerfallswinkel_max := 360 / Unterteilungen;

  IF (Zerfallswinkel_min * (Unterteilungen-1) + ZerfallsWinkel_max > 360) THEN BEGIN

    ZerfallsWinkel_Max := 360 - ZerfallsWinkel_min * (Unterteilungen - 1);

  END;

  IF Risstiefe < 5 THEN Risstiefe := 5; 



  ALLOCATE Umriss[1..Unterteilungen];

  

  HilfsobjektZaehler := 0;

  UmrissObjekteZaehler := 0;



  IF Lamellenschichten > 4 THEN Lamellenschichten := 4;

  m := Lamellen;



  FOR k := 1 TO Lamellenschichten DO BEGIN



    IF k > 2 THEN m := m * 2;



    FOR l:=1 TO m DO BEGIN



      Unterteilen(Unterteilungen);

      ZerfallPositionen (Unterteilungen, Zerfall);

      KreispunkteVerschieben(Unterteilungen);

      KreispunkteSplitten(Unterteilungen);

      RundungsPunkteErstellen(Unterteilungen);

      GegenRundungsPunkteErstellen(Unterteilungen);

      LamelleZeichnen(Unterteilungen, Lamellenunterteilung, k, 1-(k-1)*(((100-Lamellenverkleinerung)/100)/(Lamellenschichten-1)), Umrissobjekt);

      {HilfsKonstruktionZeichnen(Unterteilungen);}



    END;



  END;



  DSelectAll;

  

END;

{--------------------------------------------------------------------------------------------------------------}

{--------------------------------------------------------------------------------------------------------------}



run(Pilz);