Author Topic: 'Tis the Season  (Read 1462 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 stars

imgx = 800
imgy = 800

r0 = 300 '// radius of the 1. helix
r1 = 30  '// radius of the 2. helix
r2 = 10  '// radius of the 3. helix
ctr = 0


dim cp(3)  'for random color switching
cp(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 colors
c1 = 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,i
next
stars=xmax*ymax*10^-4.35
horizon=.67*ymax
color rgb( 0, 225, 225)
for i=1 to stars 'stars in sky
  pset rnd*xmax,rnd*horizon
next
stars=stars/2
for i=1 to stars
  circle rnd*xmax,rnd*horizon,1 filled
next
'stars=stars/2
for i=1 to stars
  circle rnd*xmax,rnd*horizon,2 filled
next

while 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 if
wend

sub 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 if
end sub

'Thanks Andy Amaya for following code
sub 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, y1
end

sub 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!