Listing 4

Display code

type
  Surfaces = record
	      Outline, Fill: TColor;
	      end;

var
  Land, Water, Vertical: Surfaces;

function Surface(Outline, Fill: TColor): Surfaces;
begin
  Result.Outline := Outline;
  Result.Fill    := Fill;
end;

function Project(const Tr: TTriple): TPixel; assembler;
{ 3D transform a point }
asm
	les	di,[Tr]
	mov	si,word ptr UnitLength	{ Scaling factor }

	mov	ax,[TTriple ptr es:di].Y	{ Tr.Y }
        imul	si			{ Scale up before division}
	idiv	VanishingPoint.Y	{ Scaled(depth/vanishing.depth) }
{DeltaY	equ	bx }
	mov     bx,ax			{ preserve DeltaY }

	mov	ax,VanishingPoint.Z
	sub	ax,[TTriple ptr es:di].Z	{ DeltaZ }
	imul	bx			{ DeltaZ * DeltaY }
	idiv	si			{ Unscale(DeltaZ*DeltaY) }
	add	ax,[TTriple ptr es:di].Z	{ Tr.Z+Unscale(DZ*DY) }
	mov	cx,[DisplayHeight]	{ It's used twice ... }
	imul	cx			{ (Z+DZ*DY)*DisplayHeight }
	idiv	si			{ Unscale }
	sub	cx,ax			{ Result.Y }

	mov	ax,VanishingPoint.X
	sub	ax,[TTriple ptr es:di].X	{ DeltaX }
	imul	bx			{ DeltaX*DeltaY }
	idiv	si			{ Unscale(DeltaX*DeltaY) }
	add	ax,[TTriple ptr es:di].X	{ Tr.X+""}
	imul	[DisplayWidth]		{ ""*DisplayWidth }
	idiv	si			{ Result.X := Unscale("") }

        mov     dx,cx                    {Return (X,Y) in ax:dx}
end;

procedure DrawPixels(const Canvas:               TCanvas;
                     const A, B, C, D:           TPixel;
                     const N:                    word;
                     const Surface:              Surfaces);
begin
  if AbortDraw then raise EAbortedDrawing.Create('');

  Canvas.Pen.Color := Surface.Outline;
  if DrawMode = dmOutline
    then if N = 3
      then Canvas.PolyLine( [A, B, C, A] )
      else Canvas.PolyLine( [A, B, C, D, A] )
    else begin
         Canvas.Brush.Color := Surface.Fill;
         if N = 3
           then Canvas.Polygon( [A, B, C] )
           else Canvas.Polygon( [A, B, C, D] )
         end;
end;

procedure CalcCrossing( var Low, High, Crossing: TTriple;
                        SetLow:                  boolean);
var
  CrossOverRatio: LongInt;
begin
   CrossOverRatio := (SeaLevel - Low.Z) * UnitLength
                     div (High.Z - Low.Z);
   { Distance of crossing point from A, as ratio of total line }
   { AB length, times UnitLength                               }
   Crossing := Triple( Low.X + Unscale((High.X - Low.X) * CrossOverRatio),
                       Low.Y + Unscale((High.Y - Low.Y) * CrossOverRatio),
                       SeaLevel );
   if SetLow then Low.Z := SeaLevel;
end;

procedure DrawVertical( Canvas: TCanvas;
                        const A, B: TTriple; var pA, pB: TPixel);
var
  pC, pD: TPixel;    px: TPixel;
  tC, tD: TTriple;
begin
  tC := A; tC.Z := SeaLevel; pC := Project(tC);
  tD := B; tD.Z := SeaLevel; pD := Project(tD);
  DrawPixels(Canvas, pA, pB, pD, pC, 4, Vertical);
end;

procedure DrawVerticals(Canvas: TCanvas);
type
  Triad = record
          T: TTriple;
          V: TVertex;
          P: TPixel;
          end;
var
  Work: Triad;

  procedure Step( const Start: TVertex;
                  var Front:   Triad;
                  var StepDn:  GridCoordinate
		);
  var
    Idx: word;
    Back, Interpolate: Triad;
  begin
    Back.V := Start;
    Back.T := GetTriple(Back.V);
    if Back.T.Z > SeaLevel then Back.P := Project(Back.T);
    for Idx := 1 to EdgeLength do
      begin
      Front.V := Back.V;
      Inc(Work.V.BC);
      Dec(StepDn);
      Front.T := GetTriple(Front.V);
      if Front.T.Z > SeaLevel then Front.P := Project(Front.T);
      case (ord(Back.T.Z > SeaLevel) shl 1) +
           ord(Front.T.Z > SeaLevel) of
        1: begin { Back below, front above }
           CalcCrossing(Back.T, Front.T, Interpolate.T, False);
           Interpolate.P := Project(Interpolate.T);
           DrawVertical( Canvas,
                         Interpolate.T, Front.T,
                         Interpolate.P, Front.P);
           end;
        2: begin { Back above, front below }
           CalcCrossing(Front.T, Back.T, Interpolate.T, False);
	   Interpolate.P := Project(Interpolate.T);
           DrawVertical( Canvas,
                         Back.T, Interpolate.T,
                         Back.P, Interpolate.P);
           end;
        3: DrawVertical(Canvas, Back.T, Front.T, Back.P, Front.P);
                 { Both above }
        end;
      Back := Front;
      end;
  end;

begin
  Step(C, Work, Work.V.AB );
  Step(B, Work, Work.V.CA );
end;

function LandColor(const A, B, C: TTriple): TColor;
begin
{ This code is too long to print - it's available electronically.

  Generates two vectors - ToEdge and ToSun - as the difference
  between one vertex to the center, and between the 'sun' and the
  center, and calculates the angle between the two as the ArcCos of
  ToEdge•ToSun / (Sqrt(ToEdge•ToEdge) * Sqrt(ToSun•ToSun)), where
  • is the inner product.

  Result is a mapping of this angle to a grayscale}
end;

procedure Draw3Vertices( Canvas: TCanvas;
                         const A, B, C: TVertex; Display: boolean);
var
  Color: TColor;
  pA, pB, pC, pD, pE: TPixel;
  tA, tB, tC, tD, tE: TTriple;
  aBelow, bBelow, cBelow: boolean;
begin
  tA := GetTriple(A); tB := GetTriple(B); tC := GetTriple(C);
  aBelow := tA.Z <= SeaLevel;
  bBelow := tB.Z <= SeaLevel;
  cBelow := tC.Z <= SeaLevel;
  case ord(aBelow) + ord(bBelow) + ord(cBelow) of
    0:       if Display then {All above}
               begin
               pA := Project(tA);
               pB := Project(tB);
               pC := Project(tC);
               if DrawMode = dmRender
                 then begin
                      Color := LandColor(tA, tB, tC);
                      DrawPixels( Canvas,
                                  pA, pB, pC, pC, 3,
                                  Surface(Color, Color));
                      end
                 else DrawPixels( Canvas,
                                  pA, pB, pC, pC, 3, Land);
               end;
    3:       if Display then {All below}
	       begin
               tA.Z := SeaLevel; tB.Z := SeaLevel; tC.Z := SeaLevel;
               pA := Project(tA);
               pB := Project(tB);
               pC := Project(tC);
               DrawPixels( Canvas, pA, pB, pC, pC, 3, Water);
               end;
    2:       begin {One vertex above water}
             { First ensure it's tA }
             if aBelow then
               if bBelow
                 then SwapTriples(tA, tC)
                 else SwapTriples(tA, tB);
             CalcCrossing(tB, tA, tD, True);
             CalcCrossing(tC, tA, tE, True);
             pA := Project(tA); pB := Project(tB); pC := Project(tC);
             pD := Project(tD); pE := Project(tE);
             DrawPixels( Canvas, pD, pB, pC, pE, 4, Water);
	     if Drawmode = dmRender
               then begin
                    Color := LandColor(tD, tA, tE);
                    DrawPixels( Canvas, pD, pA, pE, pE, 3,
                                Surface(Color, Color));
		    end
               else DrawPixels( Canvas, pD, pA, pE, pE, 3, Land);
             end;
    1:       begin {One vertex below water}
             { First ensure it's tA }
	     if bBelow
               then SwapTriples(tA, tB)
               else if cBelow then SwapTriples(tA, tC);
             CalcCrossing(tA, tB, tD, False);
             CalcCrossing(tA, tC, tE, True);
             pA := Project(tA);
             pB := Project(tB);
             pC := Project(tC);
             pD := Project(tD); pE := Project(tE);
             DrawPixels( Canvas, pD, pA, pE, pE, 3, Water);
             if DrawMode = dmRender
               then begin
                    Color := LandColor(tD, tB, tC);
		    DrawPixels( Canvas,
                                pD, pB, pC, pE, 4,
                                Surface(Color, Color));
		    end
	       else DrawPixels( Canvas, pD, pB, pC, pE, 4, Land);
	     end;
   end;
end;

procedure DrawTriangle(       Canvas:   TCanvas;
		        const A, B, C:  TVertex;
                              Plys:     word;
                              PointDn:  boolean);
var
  AB, BC, CA: TVertex;
begin
  if Plys = 1
    then Draw3Vertices( Canvas,
                        A, B, C, (DrawMode <> dmOutline) OR PointDn)
    else
      begin
      AB := Midpoint(A, B);
      BC := Midpoint(B, C);
      CA := Midpoint(C, A);
      if Plys = 3 then FractalLandscape.DrewSomeTriangles(16);
                       {Updates progress bar}
      Dec(Plys);
      if PointDn
        then begin
             DrawTriangle(Canvas, CA, BC, C, Plys, True);
             DrawTriangle(Canvas, AB, B, BC, Plys, True);
             DrawTriangle(Canvas, BC, CA, AB, Plys, False);
             DrawTriangle(Canvas, A, AB, CA, Plys, True);
             end
        else begin
             DrawTriangle(Canvas, A, CA, AB, Plys, False);
             DrawTriangle(Canvas, BC, CA, AB, Plys, True);
             DrawTriangle(Canvas, CA, C, BC, Plys, False);
             DrawTriangle(Canvas, AB, BC, B, Plys, False);
             end;
      end;
end;