### Author Topic: 'Tis the Season  (Read 1390 times)

#### B+

• Guest
##### 'Tis the Season
« on: December 17, 2016, 10:09:16 PM »
One thing lead to another with Galileo's SuperHelix in Yabasic:
Code: [Select]
`' Helix Animation.bas  SmallBASIC 0.12.8 [B+=MGA] 2016-12-17'mod this:'// SuperHelix'// FB - 201007213'// Adapted to Yabasic 2.769 by Galileo 12/2016' To animate more in Christmas Theme' Oh add a Sierpinsky tree!' Oh now add starsimgx = 800imgy = 800r0 = 300 '// radius of the 1. helixr1 = 30  '// radius of the 2. helixr2 = 10  '// radius of the 3. helixctr = 0dim cp(3)  'for random color switchingcp(0) = rgb(20,20,35)cp(1) = rgb(255,0,0)cp(2) = rgb(0,255,0)cp(3) = rgb(0,0,255)'start with Galileo's colorsc1 = cp(1)c2 = cp(3)c3 = cp(2)d = 1 for i=0 to ymax  color rgb( 20,20,i/ymax*70)  line 0,i,xmax,inextstars=xmax*ymax*10^-4.35horizon=.67*ymaxcolor rgb( 0, 225, 225)for i=1 to stars 'stars in sky  pset rnd*xmax,rnd*horizonnextstars=stars/2for i=1 to stars  circle rnd*xmax,rnd*horizon,1 fillednext'stars=stars/2for i=1 to stars  circle rnd*xmax,rnd*horizon,2 fillednextwhile 1    ctr = ctr + d    '// 1. helix point    a0 = ctr / r0 / 10    z0 = ctr * 0.01 + 80    x0 = z0/imgy * r0 * cos(a0)    y0 = r0 * sin(a0)        if z0 > imgy - 1 then d = -1 : colorSwitch    if z0 < 80 then d = 1 : colorSwitch    '// plot the 1. helix point    color c1    pset x0+imgx/2, z0    '// 2. helix point (superhelix)    a1 = ctr / r1 / 2    x1 = x0 + r1 * cos(a1) * cos(a0)    y1 = y0 + r1 * cos(a1) * sin(a0)    z1 = z0 + r1 * sin(a1)    '// plot the 2. helix point    if z1 < 0 then z1 = 0    color c2    pset x1 + imgx / 2, z1    '// 3. helix point (hyperhelix?)    a2 = ctr / r2    x2 = x1 + r2 * cos(a2) * cos(a1)    y2 = y1 + r2 * cos(a2) * sin(a1)    z2 = z1 + r2 * sin(a2)    '// plot the 3. helix point    if z2 < 0 then z2 = 0    color c3    pset x2 + imgx / 2, z2        'debug, ha! this slows down the drawing better than delay!!!    lc +=1    'color 15    'locate 1,1:print lc    if lc mod 1000 = 0 then       color rgb(0, 100, 0)      SierLineTri 200, ymax, 400, 80, 600, ymax, 0      lc1000 = lc/1000      if lc1000 % 8 then color 14 else color 15      Star(400, 80, 20, 60, 5, lc1000 mod 360, 1)    end ifwendsub colorSwitch  c1 = cp(int(rnd*4))  c2 = cp(int(rnd*4))  c3 = cp(int(rnd*4))end sub SierLineTri(x1, y1, x2, y2, x3, y3, depth)  local go, 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    if depth < 6 then    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 ifend sub'Thanks Andy Amaya for following codesub filltri(x1, y1, x2, y2, x3, y3)  local x, y, length, slope1, slope2, slope3  '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, y1endsub Star(x, y, rInner, rOuter, nPoints, angleOffset, TFfill)  ' x, y are same as for circle,  ' rInner is center circle radius  ' rOuter is the outer most point of star  ' nPoints is the number of points,  ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub  ' this is to allow us to spin the polygon of n sides  ' TFfill filled True or False (1 or 0)  local p_angle, rad_angle_offset, x1, y1, x2, y2, x3, y3, i  p_angle = rad(360 / nPoints)  :  rad_angle_offset = rad(angleOffset)  x1 = x + rInner * cos(rad_angle_offset)  y1 = y + rInner * sin(rad_angle_offset)  for i = 0 to nPoints - 1    x2 = x + rOuter * cos(i * p_angle + rad_angle_offset + .5 * p_angle)    y2 = y + rOuter * sin(i * p_angle + rad_angle_offset + .5 * p_angle)    x3 = x + rInner * cos((i + 1) * p_angle + rad_angle_offset)    y3 = y + rInner * sin((i + 1) * p_angle + rad_angle_offset)    if TFfill then      filltri x1, y1, x2, y2, x3, y3    else      line x1, y1, x2, y2      line x2, y2, x3, y3    end if    x1 = x3 : y1 = y3  next  if TFfill then circle x, y, rInner filled  end `

#### jj2007

• Guest
##### Re: 'Tis the Season
« Reply #1 on: December 18, 2016, 07:38:12 AM »
Works like a charm, thanks!