RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on December 17, 2016, 10:09:16 PM
-
One thing lead to another with Galileo's SuperHelix in Yabasic:
' 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
-
Works like a charm, thanks!