Добавил:

fench Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Сумский государственный университет

Предмет:

Программирование

Файл:

(Ebook - Pdf) Kick Ass Delphi Programming

.pdf

Скачиваний:

300

Добавлен:

17.08.2013

Размер:

5.02 Mб

Скачать

☆

<<< < Предыдущая 5 6 7 8 9 10 11 12 13 14 15 1617 / 5017 18 19 20 21 22 23 24 25 26 27 28 29 > Следующая >>>

var

DB: array[0..8384] of TTriple; { Triangular array: Vertices(MEL+1) entries }

NumberOfVertices, TopRow: word;

Envelopes: array[1..MaxPlys] of word;

function Vertices(N: word): word;

{ Vertices in an equilateral triangle with edgelength = N-1 } begin

Vertices := (Sqr(N) + N) shr 1; end;

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;

function Loc(const V: TVertex): word; begin

Loc := NumberOfVertices - Vertices(TopRow - V.AB) + V.BC;

{^^^^^^^^^^^^^^^^^^ This is actually NOT necessary and just

wastes cycles, but I have retained it for compatability with FL2 .FL files. }

end;
procedure SetTriple(var V: TVertex; var T: TTriple);	{ DB[V] := T }
begin
DB[Loc(V)] := T;
end;

function GetTriple(const V: TVertex): TTriple; { DB[V] } begin

Result := DB[Loc(V)]; end;

procedure SwapTriples(var A, B: TTriple); var

Tmp: TTriple; begin

Tmp := A; A := B; B := Tmp; end;

procedure SwapZ(var A, B: TTriple); var

C: TCoordinate; begin

C := A.Z; A.Z := B.Z; B.Z := C; end;

const

Uninitialized = -30000; procedure ResetDB;

var

T: TTriple; R, Theta: double;

I, Offset: integer; tA, tB, tC: TTriple;

const

Base_Rotation = - Pi / 2.1; {Rotate point counterclockwise a bit} RotateBy = Pi * 2 / 3; {120|}

begin

{Set Plys dependent stuff } EdgeLength := 1 shl (Plys - 1);

TopRow := EdgeLength + 1; { A "fencepost" situation } NumberOfVertices := Vertices(TopRow);

for I := Plys downto 1 do

Envelopes[I] := Envelope shr Succ(Plys - I);

{Then reset NumberOfVertices vertices in DB }

T.X := Uninitialized;

T.Y := Uninitialized;

T.Z := Uninitialized;

for I := Low(DB) to High(DB) do DB[I] := T;

{ Now, set "defining" (outside) points A, B, and C }


A.AB := 0;		A.BC :=	EdgeLength;	A.CA := 0;
B.AB := 0;		B.BC :=	0;	B.CA := EdgeLength;
C.AB := EdgeLength;		C.BC :=	0;	C.CA := 0;
{ Then, assign them triples }
Offset := UnitLength div 2;
R	:= UnitLength / 2;

Theta := Base_Rotation;

tA := Triple( Round(R * Cos(Theta)) + Offset,

Round(R * Sin(Theta)) + Offset,

SeaLevel + Rand(Envelope) );

Theta := Theta + RotateBy;

tB := Triple( Round(R * Cos(Theta)) + Offset,

Round(R * Sin(Theta)) + Offset,

SeaLevel + Rand(Envelope) );

Theta := Theta + RotateBy;

tC := Triple( Round(R * Cos(Theta)) + Offset,

Round(R * Sin(Theta)) + Offset,

SeaLevel + Rand(Envelope) );

{ At least one point above sealevel }

if (tA.Z < SeaLevel) AND (tB.Z < SeaLevel) AND (tC.Z < SeaLevel) then repeat

tB.Z := SeaLevel + Rand(Envelope); until tB.Z > SeaLevel;

{ Force A the lowest ... }

if tA.Z > tB.Z then SwapZ(tA, tB); if tA.Z > tC.Z then SwapZ(tA, tC);

SetTriple(A, tA); SetTriple(B, tB); SetTriple(C, tC);

end;

function SaveLandscape(const FileName: TFileName): boolean; var

Handle: integer; begin

Result := False; try

Handle := FileCreate(FileName); try

Result := (FileWrite(Handle, Plys, SizeOf(Plys)) = SizeOf(Plys)) and

(FileWrite(Handle, DB, NumberOfVertices * SizeOf(TTriple))

= NumberOfVertices * SizeOf(TTriple));

finally FileClose(Handle);

end; except

on {any} Exception do Result := False; end;

end;

function LoadLandscape(const FileName: TFileName): boolean; var

Handle: integer; begin

Result := False; try

Handle := SysUtils.FileOpen(FileName, fmOpenRead); try

if FileRead(Handle, Plys, SizeOf(Plys)) = SizeOf(Plys) then begin

ResetDB;

LoadLandscape := FileRead( Handle, DB,

NumberOfVertices * SizeOf(TTriple)) = NumberOfVertices * SizeOf(TTriple);

end; finally

FileClose(Handle);

end; except

on {any} Exception do Result := False; end;

end;

{ Action }

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;

end.

Go!

Keyword

To access the contents, click the chapter and section titles.

Kick Ass Delphi Programming

(Publisher: The Coriolis Group)

Author(s): Don Taylor, Jim Mischel, John Penman, Terence Goggin

ISBN: 1576100448

Publication Date: 09/01/96

Search this book:

Go!

-----------

Bending

Another subtlety that I didn’t discover until I actually wrote the code is that you shouldn’t apply the same amount of randomness when you bend the larger scale lines as when you bend the smaller scale lines. If you do, you either end up with a bumpy plane or a spiky landscape. You need to apply more randomness to the large outer triangles, which produce the overall shape of the landscape, and to apply less randomness to the smaller inner triangles, which basically control the smoothness of your landscape.

What I ended up using is a function that generates something vaguely like a normal distribution:

function Rand(Envelope: integer): integer; { Pseudonormal (sawtooth) distribution,

in range ±Envelope } begin

Rand := integer(Random(Envelope)) + integer(Random(Envelope)) - Envelope;

end;

Here, the Envelope value for each ply is half that of the next larger ply. This certainly produces plausible-looking landscapes, but real landscapes aren’t always as smooth as FL3’s. Real landscapes do have the occasional sharp edge—cliffs, mesas, canyons, and so on—while FL3 never really produces anything more abrupt than a steep slope.

One approach you may want to experiment with is to replace Rand’s pseudonormal distribution within a constricting envelope with an exponential function. On smaller scales, the function would be more likely to produce a number close to 0 than on larger scales, but it might throw out a large number on any scale.

Draw, Then Display

In the first incarnation of this program, the same recursive routine that built the landscape was responsible for drawing it. If the Plys argument was greater than 1, it broke its input triangle into four new triangles, and then decremented Plys and applied itself to each new triangle. When the Plys argument was equal to 1, it called a routine that drew the triangle.

This was certainly simple enough, but it meant that changing from a “wire mesh” rendering to a filled-triangle rendering required generating a whole new landscape. Similarly, using this simple design in a Windows version would mean that changing the window size also generates a whole new landscape. Clearly, a better approach is to generate the landscape first and then draw it. This requires two parallel recursions from the outermost triangle to the innermost ones (which are the only ones which are actually drawn), but the second recursion doesn’t cost much compared to actually drawing the rectangles, so the price of flexibility is fairly low.

Generating and Displaying the Landscape

After all that prolog, the actual generation code may seem refreshingly simple. FractureTriangle() (present in Listing 6.2) takes a triangle and the number of Plys remaining. If Plys is greater than 1, FractureTriangle() calls FractureLine() to create (or retrieve) a midpoint value, then calls itself on each of the four triangles that these midpoints define. FractureLine() calls Midpoint() (both in Listing 6.2) to calculate the vertex between its two input vertices, and then checks to see if it has been set yet. If the midpoint is still uninitialized, FractureLine() bends the line between the endpoints by raising or lowering its midpoint.

Once the landscape has been generated, FL3 uses the code in Listing 6.3 to display it in the current window, in the current display mode. If the user changes the window size or the display mode, FL3 redraws the landscape.

Listing 6.3 DISPLAY.PAS

unit Display; {Fractal Landscapes 3.0 -- Copyright _ 1987..1996, Jon Shemitz}

interface

uses WinTypes, WinProcs, SysUtils, Graphics, Forms, Global, Database;

const

DrawingNow: boolean = False; AbortDraw: boolean = False;

type

EAbortedDrawing = class (Exception) end;

procedure ScreenColors;

procedure PrinterColors;

procedure DrawTriangle(	Canvas:	TCanvas;
	const A, B, C:	TVertex;
	Plys:	word;
	PointDn:	boolean);

procedure DrawVerticals(Canvas: TCanvas);

{$ifdef Debug}

const DebugString: string = ''; {$endif}

implementation

uses Main;

type

Surfaces = record

Outline, Fill: TColor; end;

const

scrnLand: Surfaces = (Outline: clLime; Fill: clGreen); scrnWater: Surfaces = (Outline: clBlue; Fill: clNavy); scrnVertical: Surfaces = (Outline: clGray; Fill: clSilver);

prnLand: Surfaces = (Outline: clBlack; Fill: clWhite); prnWater: Surfaces = (Outline: clBlack; Fill: clWhite); prnVertical: Surfaces = (Outline: clBlack; Fill: clWhite);

var

Land, Water, Vertical: Surfaces; procedure ScreenColors;

begin
Land	:= scrnLand;
Water	:= scrnWater;
Vertical := scrnVertical;
end;
procedure PrinterColors;
begin
Land	:= prnLand;
Water	:= prnWater;
Vertical := prnVertical;
end;

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

{ $define Pascal} {$define Float} {$ifdef Pascal}

{$ifdef Float} type

TFloatTriple = record X, Y, Z: double; end;

function FloatTriple(T: TTriple): TFloatTriple; begin

Result.X := T.X / UnitLength;

Result.Y := T.Y / UnitLength;

Result.Z := T.Z / UnitLength; end;

function Project(const P: TTriple): TPixel; { 3D transform a point } var

Delta_Y: double;

Tr, V: TFloatTriple; begin

Tr := FloatTriple(P);

V := FloatTriple(VanishingPoint);

Delta_Y := Tr.Y / V.Y;

Result.X := Round( DisplayWidth *

((V.X - Tr.X) * Delta_Y + Tr.X)); Result.Y := DisplayHeight -

Round( DisplayHeight *

((V.Z - Tr.Z) * Delta_Y + Tr.Z));

end; {$else}

function Project(const Tr: TTriple): TPixel; { 3D transform a point } var

Delta_Y: integer; begin

Delta_Y := MulDiv(Tr.Y, UnitLength, VanishingPoint.Y); Result.X := MulDiv( MulDiv( VanishingPoint.X - Tr.X,

Delta_Y, UnitLength) + Tr.X,

DisplayWidth, UnitLength);

Result.Y := DisplayHeight -

MulDiv( MulDiv( VanishingPoint.Z - Tr.Z, Delta_Y, UnitLength) + Tr.Z, DisplayHeight, UnitLength );

end; {$endif}

{$else}

function Project(const Tr: TTriple): TPixel; assembler; {3D transform a point}

asm
{$ifdef Ver80} {Delphi 1.0; 16-bit}
les	di,[Tr]
mov	si,word ptr UnitLength		{ Scaling factor }
mov	ax,[TTriple ptr es:di].Y{ Tr.Y }
imul	si		{ Scale by LoWord(UnitLength) }
idiv	VanishingPoint.Y		{ Scaled(depth/vanishing.depth) }
{DeltaY	equ	bx }
mov	bx,ax		{ preserve Delta.Y }
mov	ax,VanishingPoint.Z
sub	ax,[TTriple ptr es:di].Z{ Delta.Z }
imul	bx		{ Delta.Z * Delta.Y }
idiv	si		{ Unscale(Delta.Z * Delta.Y) }
add	ax,[TTriple ptr es:di].Z{ Tr.Z + Unscale(Delta.Z * Delta.Y)
}
mov	cx,[DisplayHeight]		{ We'll use it twice here ... }
imul	cx	{ (Tr.Z+Delta.ZDelta.Y)Screen.Row }
idiv	si		{ Unscale }
sub	cx,ax		{ Px.Y }
mov	ax,VanishingPoint.X
sub	ax,[TTriple ptr es:di].X{ Delta.X }
imul	bx		{ Delta.X * Delta.Y }
idiv	si		{ Unscale(Delta.X * Delta.Y) }
add	ax,[TTriple ptr es:di].X{ Tr.X + Unscale(Delta.X * Delta.Y)
}
imul	[DisplayWidth]		{ (Tr.X+Delta.XDelta.Y)Screen.Col
}
idiv	si		{ Px.X := Unscale(above) }
mov	dx,cx		{Return (X,Y) in ax:dx}
{$else} {Delphi	2.0 or better; 32-bit}
push	ebx		{ Delphi 2.0 requires that we }
push	esi		{ preserve these registers	}
push	edi
mov	edi,eax		{ lea edi,[Tr]}
push	edx		{ Save @ Result }
mov	si,word ptr UnitLength		{ Scaling factor }
mov	ax,TTriple[edi].Y		{ Tr.Y }
imul	si		{ Scale by LoWord(UnitLength) }
idiv	VanishingPoint.Y		{ Scaled(depth/vanishing.depth) }
{DeltaY equ bx	}
mov	bx,ax		{ preserve Delta.Y }
mov	ax,VanishingPoint.Z
sub	ax,TTriple[edi].Z		{ Delta.Z }
imul	bx		{ Delta.Z * Delta.Y }
idiv	si		{ Unscale(Delta.Z * Delta.Y) }

add	ax,TTriple[edi].Z	{ Tr.Z + Unscale(Delta.Z *
		Delta.Y) }
mov	cx,[DisplayHeight]	{ We'll use it twice here ... }
imul	cx	{
		(Tr.Z+Delta.ZDelta.Y)Screen.Row }
idiv	si	{ Unscale }
sub	cx,ax	{ Px.Y }
mov	ax,VanishingPoint.X
sub	ax,TTriple[edi].X	{ Delta.X }
imul	bx	{ Delta.X * Delta.Y }
idiv	si	{ Unscale(Delta.X * Delta.Y) }
add	ax,TTriple[edi].X	{ Tr.X + Unscale(Delta.X *
		Delta.Y) }
imul	[DisplayWidth]	{
		(Tr.X+Delta.XDelta.Y)Screen.Col }
idiv	si	{ Px.X := Unscale(above) }

// Now ax=x, cx=y; we want to make them longints and save them to Result

mov	ebx,$0000FFFF
and	eax,ebx	{clear the high word}
and	ecx,ebx
pop	edx	{ restore @ Result }
mov	TPixel[edx].X,eax
mov	TPixel[edx].Y,ecx
pop	edi
pop	esi
pop	ebx
{$endif}
end;
{$endif}
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;

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;

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);

<<< < Предыдущая 5 6 7 8 9 10 11 12 13 14 15 1617 / 5017 18 19 20 21 22 23 24 25 26 27 28 29 > Следующая >>>

Соседние файлы в предмете Программирование

#
17.08.20135.02 Mб300(Ebook - Pdf) Kick Ass Delphi Programming.pdf
#
17.08.20134.34 Mб137(ebook) Programing - Introduction to Visual Basic NET.pdf
#
17.08.201315.38 Mб131(ebook) Visual Studio .NET Mastering Visual Basic.pdf
#
17.08.20131.25 Mб51100 Linux Tips And Tricks.pdf
#
17.08.201317.91 Mб1483D Game Programming All In One (2004).pdf
#
17.08.201350.02 Mб583ds Max 6 Bible (2004).pdf