Listing 3

Fracturing lines and triangles

function Midpoint(A, B: TVertex): TVertex;
begin
  Result := Vertex( (A.AB + B.AB) shr 1, { Average }
                    (A.BC + B.BC) shr 1,
                    (A.CA + B.CA) shr 1 );
end;

procedure FractureLine( var vM: TVertex;
                        const vA, vB: TVertex;
                        Envelope: integer);
var
  A, B, M: TTriple;
begin
  vM := Midpoint(vA, vB);
  M  := GetTriple(vM);
  if M.X = Uninitialized then { Not set yet }
    begin
    A := GetTriple(vA); B := GetTriple(vB);
    M := Triple( A.X + (B.X - A.X) div 2,
                 A.Y + (B.Y - A.Y) div 2,
                 A.Z + (B.Z - A.Z) div 2 + Rand(Envelope) );
    { Mean height ± Random(Envelope) }
    SetTriple(vM, M);
    end;
end;

procedure FractureTriangle(const A, B, C: TVertex; Plys: word);
var
  Envelope: word;
  AB, BC, CA: TVertex;
begin
  if Plys > 1 then
    begin
    Envelope := Envelopes[Plys];
    FractureLine(AB, A, B, Envelope);
    FractureLine(BC, B, C, Envelope);
    FractureLine(CA, C, A, Envelope);
    Dec(Plys);
    FractureTriangle(CA, BC, C, Plys);
    FractureTriangle(AB, B, BC, Plys);
    FractureTriangle(BC, CA, AB, Plys);
    FractureTriangle(A, AB, CA, Plys);
    end;
end;