Beat this!

[B+]

Beat the sub routine for drawing Sierpinski, I don't mean beat this code that demo's that sub's flexibility.

Sierpinski in Space is the title for this demo when I get around to cleaning it up:

Code: [Select]

' ss3 w RECR sier.bas  SmallBASIC 0.12.6 [B+=MGA] 2016-05-20
'from  screen saver number 1.bas 2016-02-11 SmallBASIC 0.12.0 [B+=MGA]
' this version replaces solid triangle with Sierpinski

randomize
label restart

ntri=(rnd*5)\1+1
dim x1(ntri),x2(ntri),x3(ntri),y1(ntri),y2(ntri),y3(ntri),ct(ntri)
dim dx1(ntri),dx2(ntri),dx3(ntri),dy1(ntri),dy2(ntri),dy3(ntri)
for i=1 to ntri
  x1(i)=(xmax+200)*rnd-100 : x2(i)=(xmax+200)*rnd-100 : x3(i)=(xmax+200)*rnd-100
  y1(i)=(ymax+200)*rnd-100 : y2(i)=(ymax+200)*rnd-100 : y3(i)=(ymax+200)*rnd-100
  dx1(i)=10*rnd*rdir : dx2(i)=10*rnd*rdir : dx3(i)=10*rnd*rdir
  dy1(i)=5*rnd*rdir : dy2(i)=5*rnd*rdir : dy3(i)=5*rnd*rdir
  c1=int(rnd*2):c2=int(rnd*2):c3=int(rnd*2)
  ct(i)=rgb((55+200*rnd)*c1,(50+200*rnd)*c2,(55+200*rnd)*c3)
  if ct(i)=0 then ct(i)=rgb(255,0,0)
next
timesup = rnd*5000+15000
t=ticks

while ticks-t<timesup
  if len(inkey) then goto restart
  cls
  for i=1 to ntri
    color ct(i)
    SierLineTri x1(i),y1(i),x2(i),y2(i),x3(i),y3(i),0
    x1(i)=x1(i)+dx1(i)
    if x1(i)<-100 then dx1(i)=dx1(i)*-1
    if x1(i)>xmax+100 then dx1(i)=dx1(i)*-1
    x2(i)=x2(i)+dx2(i)
    if x2(i)<-100 then dx2(i)=dx2(i)*-1
    if x2(i)>xmax+100 then dx2(i)=dx2(i)*-1
    x3(i)=x3(i)+dx3(i)
    if x3(i)<-100 then dx3(i)=dx3(i)*-1
    if x3(i)>xmax+100 then dx3(i)=dx3(i)*-1
    y1(i)=y1(i)+dy1(i)
    if y1(i)<-100 then dy1(i)=dy1(i)*-1
    if y1(i)>ymax+100 then dy1(i)=dy1(i)*-1
    y2(i)=y2(i)+dy2(i)
    if y2(i)<-100 then dy2(i)=dy2(i)*-1
    if y2(i)>ymax+100 then dy2(i)=dy2(i)*-1
    y3(i)=y3(i)+dy3(i)
    if y3(i)<-100 then dy3(i)=dy3(i)*-1
    if y3(i)>ymax+100 then dy3(i)=dy3(i)*-1
  next
  showpage
  delay 10
wend
goto restart

func rdir()
  if int(rnd*2) then rdir=1 else rdir=-1
end


'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
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'                                  Beat this!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

sub SierLineTri(x1, y1, x2, y2, x3, y3, depth)
  local mx1, mx2, mx3, my1, my2, my3

  if depth = 0 then      'draw outer most "skin"
    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
 
  'draw inner triangle
  line mx1, my1, mx2, my2
  line mx2, my2, mx3, my3
  line mx1, my1, mx3, my3
 
  'IF YOU WANT DEPTH FLEXIBILITY THEN
  'in next line change 4 to MaxDepth and make MaxDepth either a constant or another parameter in call
  'END IF
  if depth < 4 then ' are we done drawing? no, call me
    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

Flexible, easy to use and understand. It can draw a Sierpinskiy at a given depth from any 3 points.

[Aurel]

well yes really nice demo MGA 
but beat this..it can be done in most of well known interpreter or compilers

[B+]

well yes really nice demo MGA 
but beat this..it can be done in most of well known interpreter or compilers

Yes, I hope everyone understands I am talking about a coding method and not a dialect challenge.
For any dialect that can do recursive calls, this would be an ideal method to draw Sierpinski triangle with lines.

Here is a SmallBASIC example translated from recent JB post for Memorial Day weekend (for who honor it):

Code: [Select]

'Unbeatable Sier.bas for SmallBASIC 0.12.6 [B+=MGA] 2016-05-27
'translated from Unbeatable Sier.txt for Just Basic v1.01 [B+=MGA] 2016-05-27

'============================== main code
cx = XMAX /2 : cy = YMAX /2 : cx4 = .25 * XMAX : cy4 = .25 * YMAX
cx34 = .75 * XMAX : cy34 = .75 * YMAX
red
SierLineTri 0, 0, cx, 0, 0, YMAX, 0

white
SierLineTri cx, 0, XMAX, YMAX, 0, YMAX, 0

blue
SierLineTri cx, 0, XMAX, YMAX, XMAX, 0, 0

delay 4000
color 0,15 : cls

blue
ftriangle 0,  0,  cx,  0, cx4, cy4
ftriangle 0, cy,  cx, cy, cx4, cy4

red
ftriangle cx,  cy4, XMAX,    0, XMAX,  cy4
ftriangle cx,   cy, XMAX,  cy4, XMAX,   cy
ftriangle  0,   cy,    0, cy34, XMAX, cy34
ftriangle  0, cy34,    0, YMAX, XMAX, YMAX

SierLineTri cx,    0,   cx,  cy4, XMAX,    0, 0
SierLineTri cx,  cy4,   cx,   cy, XMAX,  cy4, 0
SierLineTri  0,   cy, XMAX,   cy, XMAX, cy34, 0
SierLineTri  0, cy34, XMAX, cy34, XMAX, YMAX, 0

white
SierLineTri  0,    0,   cx,    0,  cx4,  cy4, 0
SierLineTri  0,   cy,   cx,   cy,  cx4,  cy4, 0
SierLineTri cx,  cy4, XMAX,    0, XMAX,  cy4, 0
SierLineTri cx,   cy, XMAX,  cy4, XMAX,   cy, 0
SierLineTri  0,   cy,    0, cy34, XMAX, cy34, 0
SierLineTri  0, cy34,    0, YMAX, XMAX, YMAX, 0

blue
SierLineTri   0,   0, cx4, cy4,  0, cy, 0
SierLineTri cx4, cy4,  cx,   0, cx, cy, 0

pause
'procedures ======================================================

'This sub is unbeatable routine for drawing Sierpinski with lines
sub SierLineTri(x1, y1, x2, y2, x3, y3, depth)
  local mx1, mx2, mx3, my1, my2, my3
  if depth = 0 then      'draw outer most "skin" triangle
    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

  'draw all inner triangles
  line mx1, my1, mx2, my2
  line mx2, my2, mx3, my3
  line mx1, my1, mx3, my3

  'to make depth more flexible, change 4 to MaxDepth
  'and add MaxDepth to Globals list or as another parameter
  if depth < 4 then ' are we done drawing? no, call me
    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

sub red
    color rgb(200, 0, 0)
end sub

sub white
    color rgb(255, 255, 255)
end sub

sub blue
    color rgb(0, 0, 180)
end sub

'Fast Filled Triangle Sub by AndyAmaya
Sub ftriangle(x1, y1, x2, y2, x3, y3)
  local x, y, slope1, slope2, slope3, length
    'triangle coordinates must be ordered: where x1 < x2 < x3
    If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x  : y1 = y
    'swap x1, y1, with x3, y3
    If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x  : y1 = y
    'swap x2, y2 with x3, y3
    If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x  : y2 = y
    If x1 <> x3 Then slope1 = (y3 - y1) / (x3 - x1)
    'draw the first half of the triangle
    length = x2 - x1
    If length <> 0 Then
        slope2 = (y2 - y1) / (x2 - x1)
        For x = 0 To length
            Line int(x + x1), int(x * slope1 + y1), int(x + x1), int(x * slope2 + y1)
        Next
    End If
    'draw the second half of the triangle
    y = length * slope1 + y1 : length = x3 - x2
    If length <> 0 Then
        slope3 = (y3 - y2) / (x3 - x2)
        For x = 0 To length
            Line int(x + x2), int(x * slope1 + y), int(x + x2), int(x * slope3 + y2)
        Next
    End If
    line x1, y1, x2, y2
    line x2, y2, x1, y1
    line x2, y2, x3, y3
    line x3, y3, x2, y2
    line x1, y1, x3, y3
    line x3, y3, x1, y1
End Sub


Notes to understanding and translating SmallBASIC code to your favorite dialect:
XMAX and YMAX are SmallBASIC constants for Screen Width and Screen Height, there is no adjustable screen to setup.
Also all variables are global unless declared LOCAL in procedures (kind of backwards from what people may be accustomed).

[Aurel]

of course i see ...well ithink that i have something similar in xblite i will see...

[ZXDunny]

Okay, here's the only approach that hasn't been tried:

Code: [Select]

10 REM Sierpinski
20 n=LEN FCHR$ 0,s$=FCHR$(SCRw/2)+FCHR$(SCRh/2)+FCHR$(SCRh/2)
30 x=FCODE s$( TO n),y=FCODE s$(n+1 TO n*2),l=FCODE s$(n*2+1 TO n*3),l1=l*0.5774,s$=s$(n*3+1 TO): POLYGON x-l1,y TO x+l1,y TO x,y+l: l/=2: IF l>=1 THEN s$=s$+FCHR$(x)+FCHR$(y-l)+FCHR$(l)+FCHR$(x-l1)+FCHR$(y+l)+FCHR$(l)+FCHR$(x+l1)+FCHR$(y+l)+FCHR$(l): GO TO 30 ELSE IF s$<>"" THEN GO TO 30

I'll expand it into a more easy to read format:

Code: [Select]

10 REM Sierpinski
20 n=LEN FCHR$ 0,s$=FCHR$(SCRw/2)+FCHR$(SCRh/2)+FCHR$(SCRh/2)
30 x=FCODE s$( TO n),y=FCODE s$(n+1 TO n*2),l=FCODE s$(n*2+1 TO n*3),l1=l*0.5574,s$=s$(n*3+1 TO):
   POLYGON x-l1,y TO x+l1,y TO x,y+l:
   l/=2:
   IF l>=1 THEN
      s$=s$+FCHR$(x)+FCHR$(y-l)+FCHR$(l)+FCHR$(x-l1)+FCHR$(y+l)+FCHR$(l)+FCHR$(x+l1)+FCHR$(y+l)+FCHR$(l):
      GO TO 30
   ELSE
      IF s$<>"" THEN
         GO TO 30

I think that's quite neat, myself.

D.

[B+]

  D your procedures are so fancy, I can't tell.... well I am sure it is fabulous!

I have a Sampler in sldbas:

Code: [Select]

'Sierpinski Sampler.sdlbas [B+=MGA] 2016-05-27

const pi =  atan(1) * 4
const rad2deg =180 / pi
const deg2rad = pi / 180

randomize
option qbasic
const XMAX = 800
const YMAX = 740
setdisplay(XMAX, YMAX, 32, 1)
setcaption("Sierpinski Sampler")

function rlh(L,H)
rLH= rnd(H+2-L)-1+L
end function

function rrn(real)
rrn = real * rnd(10000)/10000
end function

sub cr(r,g,b)
ink(rgb(r,g,b))
end sub

'This sub is unbeatable routine for drawing Sierpinski with lines
sub SierLineTri(x1, y1, x2, y2, x3, y3, depth)

  if depth = 0 then      'draw outer most "skin" triangle
    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 : end if
  if y2 < y1 then : my1 = (y1 - y2)/2 + y2 : else : my1 = (y2 - y1)/2 + y1 : end if
  if x3 < x2 then : mx2 = (x2 - x3)/2 + x3 : else : mx2 = (x3 - x2)/2 + x2 : end if
  if y3 < y2 then : my2 = (y2 - y3)/2 + y3 : else : my2 = (y3 - y2)/2 + y2 : end if
  if x3 < x1 then : mx3 = (x1 - x3)/2 + x3 : else : mx3 = (x3 - x1)/2 + x1 : end if
  if y3 < y1 then : my3 = (y1 - y3)/2 + y3 : else : my3 = (y3 - y1)/2 + y1 : end if

  'draw all inner triangles
  line(mx1, my1, mx2, my2)
  line(mx2, my2, mx3, my3)
  line(mx1, my1, mx3, my3)

  'to make depth more flexible, change 4 to MaxDepth
  'and add MaxDepth to Globals list or as another parameter
  if depth < 4 then ' are we done drawing? no, call me
    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

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! main

cx = XMAX / 2 : cy = YMAX / 2 : r = cy : ao = 0
cr(150, 200, 250) : text(10, 10, 24, "A Sierpinski Flower")
for j = 1 to 4
r = r - 40 : ao = 1 : cr(63 * j, 255 - 63 * j, 0)
for i = 0 to 2 * pi step pi/6
SierLineTri(cx, cy, cx + r * cos(i + ao), cy +r * sin(i + ao), cx + r * cos(i + pi / 3.3 + ao), cy + r * sin(i + pi / 3.3 + ao), 0)
next
next
wait(10000)
cls
r = cy - 20 : ngon = 3
for j = 1 to 25
stepper = 2 * pi / ngon
cls
cr(150, 200, 250) : text(10, 10, 24, str(ngon) + " - Sierpinsky Polygon:")
for i = 0 to 2 * PI -.01 step stepper
cr(rlh(128, 255), rlh(128, 255) * rlh(0, 1), rlh(128, 255) * rlh(0, 1))
SierLineTri(cx, cy, cx + r * cos(i), cy + r * sin(i), cx + r * cos(i + stepper), cy + r * sin(i + stepper), 0)
next
screenswap
wait(2000)
ngon += 1
next
wait(2000)
cls
r = cy - 20 : ngon = rlh(3, 21)
while key(27) = 0
stepper = 2 * pi / ngon
cls
cr(50, 200, 250) : text(10, 10, 24, "Crazy Polys      Press esc...")
for i = 0 to 2 * PI -.01 step stepper
r2 = rrn(r-100) + 100
cr(rlh(128, 255), rlh(128, 255) * rlh(0, 1), rlh(128, 255) * rlh(0, 1))
SierLineTri(cx, cy, cx + r2 * cos(i), cy + r2 * sin(i), cx + r2 * cos(i + stepper), cy + r2 * sin(i + stepper), 0)
next
screenswap
wait(2000)
ngon = rlh(3, 21)
wend


[ZXDunny]

Pfft. Procedures?

That one doesn't use any procedures. Or recursion. Or an array... I posted a better version on Aurel's site, which allows you to set the depth.

D.

[B+]

Hi D, sorry I meant your built in routines.

FCHR$

FCODE

POLYGON ... TO  ... TO

GO TO