Sierpinski Triangle 3D

[Galileo]

Ported from SmallBasic.

Code: [Select]

// 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

[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: [Select]

_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


[Galileo]

Interesting.