Basicprogramming(.org) > Code and examples
Sierpinski Triangle 3D
(1/1)
Galileo:
Ported from SmallBasic.
--- Code: ---// Adpated from non recursive sierpinsky.bas for SmallBASIC 0.12.6 [B+=MGA] 2016-05-19 with demo mod 2016-05-29
//Sierpinski triangle gasket drawn with lines from any 3 given points
// WITHOUT RECURSIVE Calls
//first a sub, given 3 points of a triangle draw the traiangle within
//from the midpoints of each line forming the outer triangle
//this is the basic Sierpinski Unit that is repeated at greater depths
//3 points is 6 arguments to function plus a depth level
xmax=800:ymax=600
open window xmax,ymax
backcolor 0,0,0
color 255,0,0
clear window
sub SierLineTri(x1, y1, x2, y2, x3, y3, maxDepth)
local mx1, mx2, mx3, my1, my2, my3, ptcount, depth, i, X, Y
Y = 1
//load given set of 3 points into oa = outer triangles array, ia = inner triangles array
ptCount = 3
depth = 1
dim oa(ptCount - 1, 1) //the outer points array
oa(0, X) = x1
oa(0, Y) = y1
oa(1, X) = x2
oa(1, Y) = y2
oa(2, X) = x3
oa(2, Y) = y3
dim ia(3 * ptCount - 1, 1) //the inner points array
iaIndex = 0
while(depth <= maxDepth)
for i=0 to ptCount-1 step 3 //draw outer triangles at this level
if depth = 1 then
line oa(i,X), oa(i,Y), oa(i+1,X), oa(i+1,Y)
line oa(i+1,X), oa(i+1,Y), oa(i+2,X), oa(i+2,Y)
line oa(i,X), oa(i,Y), oa(i+2,X), oa(i+2,Y)
end if
if oa(i+1,X) < oa(i,X) then mx1 = (oa(i,X) - oa(i+1,X))/2 + oa(i+1,X) else mx1 = (oa(i+1,X) - oa(i,X))/2 + oa(i,X) endif
if oa(i+1,Y) < oa(i,Y) then my1 = (oa(i,Y) - oa(i+1,Y))/2 + oa(i+1,Y) else my1 = (oa(i+1,Y) - oa(i,Y))/2 + oa(i,Y) endif
if oa(i+2,X) < oa(i+1,X) then mx2 = (oa(i+1,X)-oa(i+2,X))/2 + oa(i+2,X) else mx2 = (oa(i+2,X)-oa(i+1,X))/2 + oa(i+1,X) endif
if oa(i+2,Y) < oa(i+1,Y) then my2 = (oa(i+1,Y)-oa(i+2,Y))/2 + oa(i+2,Y) else my2 = (oa(i+2,Y)-oa(i+1,Y))/2 + oa(i+1,Y) endif
if oa(i+2,X) < oa(i,X) then mx3 = (oa(i,X) - oa(i+2,X))/2 + oa(i+2,X) else mx3 = (oa(i+2,X) - oa(i,X))/2 + oa(i,X) endif
if oa(i+2,Y) < oa(i,Y) then my3 = (oa(i,Y) - oa(i+2,Y))/2 + oa(i+2,Y) else my3 = (oa(i+2,Y) - oa(i,Y))/2 + oa(i,Y) endif
//color 9 //testing
//draw all inner triangles
line mx1, my1, mx2, my2
line mx2, my2, mx3, my3
line mx1, my1, mx3, my3
//x1, y1 with mx1, my1 and mx3, my3
ia(iaIndex,X) = oa(i,X)
ia(iaIndex,Y) = oa(i,Y) : iaIndex = iaIndex + 1
ia(iaIndex,X) = mx1
ia(iaIndex,Y) = my1 : iaIndex = iaIndex + 1
ia(iaIndex,X) = mx3
ia(iaIndex,Y) = my3 : iaIndex = iaIndex + 1
//x2, y2 with mx1, my1 and mx2, my2
ia(iaIndex,X) = oa(i+1,X)
ia(iaIndex,Y) = oa(i+1,Y) : iaIndex = iaIndex + 1
ia(iaIndex,X) = mx1
ia(iaIndex,Y) = my1 : iaIndex = iaIndex + 1
ia(iaIndex,X) = mx2
ia(iaIndex,Y) = my2 : iaIndex = iaIndex + 1
//x3, y3 with mx3, my3 and mx2, my2
ia(iaIndex,X) = oa(i+2,X)
ia(iaIndex,Y) = oa(i+2,Y) : iaIndex = iaIndex + 1
ia(iaIndex,X) = mx2
ia(iaIndex,Y) = my2 : iaIndex = iaIndex + 1
ia(iaIndex,X) = mx3
ia(iaIndex,Y) = my3 : iaIndex = iaIndex + 1
next i
//debug OH!
//for i= 0 to 3 * ptCount - 1
// print ia(i,X);", ";ia(i,Y)
//next
//update and prepare for next level
ptCount = ptCount * 3
depth = depth + 1
redim oa(ptCount - 1, 1 )
for i = 0 to ptCount - 1
oa(i, X) = ia(i, X)
oa(i, Y) = ia(i, Y)
next i
redim ia(3 * ptCount - 1, 1)
iaIndex = 0
wend
end sub
//Test Demo for the sub (NEW as 2016 - 05 - 29 !!!!!)
cx=xmax/2
cy=ymax/2
r=cy - 20
N=3
for i = 0 to 2
color 64+42*i,64+42*i,64+42*i
SierLineTri(cx, cy, cx+r*cos(2*pi/N*i), cy +r*sin(2*pi/N*i), cx + r*cos(2*pi/N*(i+1)), cy + r*sin(2*pi/N*(i+1)), 5)
next i
--- End code ---
B+:
Here are a couple of Sierpinski Snowflakes I worked up this morning. I am still working on 'Koch"-ing the points of the second one that is rotating and expanding and folding all the way inward (Snowflake #3).
B+:
Here it is folded inwards:
B+:
Well "Koch"ing was too complicated so another version of Sierpinski Snowflake with code for all above:
--- Code: ---_TITLE "Sierpinski Snowflake"
CONST xmax = 700
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 250, 20
center = xmax / 2
orad = center - 6
ir = orad / 3
p6 = _PI(2 / 6)
p3 = 2 * p6
p12 = p6 / 2
dir = 1
inc = .01
ao = 0
ainc = _PI(1 / 360)
x1 = center + orad * COS(0)
y1 = center + orad * SIN(0)
x2 = center + orad * COS(p3)
y2 = center + orad * SIN(p3)
x3 = center + orad * COS(2 * p3)
y3 = center + orad * SIN(2 * p3)
SierLineTri x1, y1, x2, y2, x3, y3, 0
x1 = center + orad * COS(0 + p6)
y1 = center + orad * SIN(0 + p6)
x2 = center + orad * COS(p + p3 + p6)
y2 = center + orad * SIN(p + p3 + p6)
x3 = center + orad * COS(2 * p3 + p6)
y3 = center + orad * SIN(2 * p3 + p6)
SierLineTri x1, y1, x2, y2, x3, y3, 0
_DELAY 5
WHILE _KEYDOWN(27) = 0
CLS
f = f + inc * dir
IF f < 0 THEN f = 0: dir = dir * -1
IF f > 1 THEN f = 1: dir = dir * -1
FOR i = 0 TO 6
x1 = center + ir * COS(i * p6 + ao)
y1 = center + ir * SIN(i * p6 + ao)
IF i > 0 THEN
x2 = center + f * orad * COS(i * p6 - p12 + ao)
y2 = center + f * orad * SIN(i * p6 - p12 + ao)
SierLineTri center, center, lastx, lasty, x1, y1, 0
SierLineTri lastx, lasty, x1, y1, x2, y2, 0
END IF
lastx = x1: lasty = y1
NEXT
ao = ao + ainc
_DISPLAY
_LIMIT 30
WEND
r1 = orad * .1
r2 = orad * .9
p16 = _PI(1 / 16)
WHILE _KEYDOWN(32) = 0
CLS
f = f + inc * dir
IF f < 0 THEN f = 0: dir = dir * -1
IF f > 1 THEN f = 1: dir = dir * -1
FOR i = 0 TO 6
x1 = center + r1 * COS(i * p6 + ao)
y1 = center + r1 * SIN(i * p6 + ao)
IF i > 0 THEN
x2 = center + orad * COS(i * p6 + ao)
y2 = center + orad * SIN(i * p6 + ao)
x3 = center + r2 * COS(i * p6 - p16 + ao)
y3 = center + r2 * SIN(i * p6 - p16 + ao)
x4 = center + r2 * COS(i * p6 + p16 + ao)
y4 = center + r2 * SIN(i * p6 + p16 + ao)
SierLineTri center, center, lastx, lasty, x1, y1, 0
SierLineTri x1, y1, x3, y3, x4, y4, 0
SierLineTri x3, y3, x4, y4, x2, y2, 0
END IF
lastx = x1: lasty = y1
NEXT
ao = ao + ainc
_DISPLAY
_LIMIT 30
WEND
SUB SierLineTri (x1, y1, x2, y2, x3, y3, depth)
'IF depth = 0 THEN 'draw out triangle if level 0
' LINE (x1, y1)-(x2, y2)
' LINE (x2, y2)-(x3, y3)
' LINE (x1, y1)-(x3, y3)
'END IF
'find midpoints
IF x2 < x1 THEN mx1 = (x1 - x2) / 2 + x2 ELSE mx1 = (x2 - x1) / 2 + x1
IF y2 < y1 THEN my1 = (y1 - y2) / 2 + y2 ELSE my1 = (y2 - y1) / 2 + y1
IF x3 < x2 THEN mx2 = (x2 - x3) / 2 + x3 ELSE mx2 = (x3 - x2) / 2 + x2
IF y3 < y2 THEN my2 = (y2 - y3) / 2 + y3 ELSE my2 = (y3 - y2) / 2 + y2
IF x3 < x1 THEN mx3 = (x1 - x3) / 2 + x3 ELSE mx3 = (x3 - x1) / 2 + x1
IF y3 < y1 THEN my3 = (y1 - y3) / 2 + y3 ELSE my3 = (y3 - y1) / 2 + y1
LINE (mx1, my1)-(mx2, my2) ' 'draw all inner triangles
LINE (mx2, my2)-(mx3, my3)
LINE (mx1, my1)-(mx3, my3)
IF depth < 4 THEN 'not done so call me again
SierLineTri x1, y1, mx1, my1, mx3, my3, depth + 1
SierLineTri x2, y2, mx1, my1, mx2, my2, depth + 1
SierLineTri x3, y3, mx3, my3, mx2, my2, depth + 1
END IF
END SUB
--- End code ---
Galileo:
Interesting.
Navigation
[0] Message Index
Go to full version