'===========================================================================
' Subject: 3D FRACTAL                         Date: 02-24-97 (16:00)       
'  Author: R.C. Sanguinet                     Code: QB, QBasic, PDS        
'  Origin: harryst@castel.nl                Packet: EGAVGA.ABC
'===========================================================================
'Written by: R.C. Sanguinet
'            MeadowPond Drive
'            Leominster, Ma. 01459
'
'    This Program quickly calculates a Three Dimesional appearing Fractal
' even though all the points are specified in one plane.
'
defint a-z
dim xp(14000) , yp(14000)
'
PRINT "PRESS ANY KEY TO BEGIN"
'
WHILE A$=""
  R=RND : A$=INKEY$
WEND
'
screen 9                            'ega needed
'
def fnr(x)=int(rnd*x)
'   lns, Xi,Yi, ... Xpts, Ypts
data 2 , 20,330 , 600,330 , 300,20
'
read lns                    'this reads the initial points
pts=lns*(lns+1)/2
for i=1 to pts
	read xp(i),yp(i)
next i
'
m=200                      'This number is used to calculate the movement of
'                           new triangles center.
while m=>2
'
	for i=(lns-1) to 1 step -1            'Spread the points
		for j=0 to i
			a=(i+1)*(i+2)/2-j
			b=(i*2+1)*(i+1)-2*j             '(i*2+2)/2 = (i+1)
			xp(b)=xp(a)
			yp(b)=yp(a)
		next j
	next i
'
 lns=(lns-1)*2 + 1 : pts=lns*(lns+1)/2 : m=m/2 : C=C+1
 '
	for i=2 to (lns-1) step 2           'Horizontal midpoints
		for j=1 to (i-1) step 2
			a=(i+1)*(i+2)/2-j
			xp(a)=(xp(a-1)+xp(a+1))/2 +fnr(m)
			yp(a)=(yp(a-1)+yp(a+1))/2 +fnr(m)
		next j
	next i
'
	for i=1 to (lns-2) step 2
		for j=1 to i step 2
			a=(i+1)*(i+2)/2-j
			u=a-i                         'line above
			l=a+i+1                       'line below
			xp(a)=(xp(u)+xp(l))/2  +fnr(m)
			yp(a)=(yp(u)+yp(l))/2  +fnr(m)     'x & y Vertical Midpoints
			xp(a+1)=(xp(u)+xp(l+2))/2 +fnr(m)
			yp(a+1)=(yp(u)+yp(l+2))/2 +fnr(m)  '       Diagonal Midpoints
		next j
	next i
'cls
'
for i=1 to (lns-1)                      'Horizontal lines
	a=i*(i+1)/2 +1
	pset (xp(a),yp(a)),C
	for j=1 to i
		line -(xp(a+j),yp(a+j)),C
	next j
next i
'
a=1 : j=2          'Plot vertical points
while a<pts
	b=a
	i=j-1
	pset (xp(b),yp(b)),C
	b=b+i
	while b<pts
		i=i+1
		line -(xp(b),yp(b)),C
		b=b+i
	wend
	a=a+j
	j=j+1
wend
'
a=1 : j=1             '   Diagonal Points
while j<lns
	b=a
	i=j+1
	pset (xp(b),yp(b)),C
	b=b+i
	while b<=pts
		i=i+1
		line -(xp(b),yp(b)),C
		b=b+i
	wend
	a=a+j
	j=j+1
wend
'
'
Wend
'
end