Contributor: SCOTT EARNEST
program Chaos;
{Triangular fractal generator
Based on program "Chaos" published in Nibble, June 1989 (Vol. 10, No. 6)
One-Liner winner written by Max Raymond of Huston, TX. Program inspired
by a PBS broadcast of Nova, called "Chaos".
Adapted for Turbo Pascal by Scott Earnest, 1994.
scott@whiplash.pc.cc.cmu.edu
About the program:
When the program is run, it will ask for 4 sets of coordinates. The first
three are the vertices of the triangle, and the fourth is the location of
the "traveler", the point that moves around the screen leaving its path.
The traveler may start at any position either inside or outside the tri-
angle. Press any key to exit the program.
The original author's comment about the program:
"A three-sided die is simulated, and its roll corresponds to one of
the three vertices of the triangle. The traveler will move halfway
from its current point toward the vertex selected by the die roll.
A copy of the traveler is left behind at its old position, while
the traveler is redrawn at its new position. The process is then
repeated. The pattern that emerges is a record of the traveler's
journey, as it jumps from point to point."
}
uses graph, crt;
const BGIPath : string[80] = 'E:\BP\BGI';
type
TPoint = record
x, y : integer;
end;
var
grDriver,
grMode,
grError : integer;
MaxX, MaxY : word;
TriExt : array [1 .. 4] of TPoint;
procedure StartGraph;
begin
grDriver := Detect;
initgraph (grDriver, grMode, BGIPath);
grError := GraphResult;
if grError grOk then
begin
writeln ('Graphics error: ', GraphErrorMsg(grError));
halt (1);
end;
MaxX := getmaxx;
MaxY := getmaxy;
end;
procedure InputPoints;
var
pnum : byte;
tx, ty : word;
function inputnum (idx : byte; max : word; ch : char) : word;
var
inval, err : word;
instr : string;
begin
repeat
if idx < 4 then write ('Enter ',ch,' vertex #',idx,': ') else write ('Enter "traveler" start ',ch,': '); readln (instr); val (instr, inval, err); if (err> 0) or (inval> max) then
writeln ('Invalid entry. Please re-enter.');
until (inval <= Max);
inputnum := inval;
end;
begin
writeln ('Screen range = X:(0-',MaxX,'); Y:(0-',MaxY,').');
for pnum := 1 to 4 do
begin
TriExt[pnum].x := inputnum (pnum, MaxX, 'X');
TriExt[pnum].y := inputnum (pnum, MaxY, 'Y');
end;
end;
procedure DrawChaos;
var
select : byte;
begin
while keypressed do readkey;
repeat
select := random(3) + 1;
TriExt[4].x := TriExt[4].x + (TriExt[select].x - TriExt[4].x) div 2;
TriExt[4].y := TriExt[4].y + (TriExt[select].y - TriExt[4].y) div 2;
putpixel (TriExt[4].x, TriExt[4].y, 15);
until keypressed;
while keypressed do readkey;
end;
begin
Randomize;
StartGraph;
RestoreCRTMode;
clrscr;
InputPoints;
SetGraphMode (GetGraphMode);
DrawChaos;
CloseGraph;
RestoreCRTMode;
clrscr;
end.