RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on June 04, 2016, 02:26:04 AM
-
'Star Maker 2 more demos.sdlbas [B+=MGA] 2016-06-03
'demo1 shows star fills for various number of points
'demo2 have fun seeding stars, move mouse around to drop seeds,
'the closer to bottom of screen the more likely a star will spring from the seed
option qbasic
const pi = acos(-1)
const radians = pi/180 'to convert an angle measured in degrees to and angle measure in radians, just mutiply by this
const xmax = 1200
const ymax = 700
const cx = xmax/2
const cy = ymax/2
setdisplay(xmax, ymax, 32, 1)
setcaption("Star Maker")
autoback(-2)
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)
pAngle = radians * (360 / nPoints)
radAngleOffset = radians * angleOffset
x1 = x + rInner * cos(radAngleOffset)
y1 = y + rInner * sin(radAngleOffset)
for i = 0 to nPoints - 1
x2 = x + rOuter * cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * sin((i + 1) * pAngle + radAngleOffset)
if TFfill then
triangle(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
fillcircle(x, y, rInner)
end if
end sub
function rand(n1, n2) ' numbers between n1, n2 inclusive, no worries first and second argument
dim hi, lo
if n1 > n2 then
hi = n1 : lo = n2
else
hi = n2 : lo = n1
end if
rand = rnd(hi - lo + 2) + lo -1
end function
function rclr() 'set a rand color fairly bright
dim test
test = rgb( rand(255, 64) * rand(0, 1), rand(255, 64) * rand(0, 1), rand(255, 64) * rand(0, 1) )
if test then
rclr = test
else
rclr = rgb(255, 255, 255)
end if
end function
function rdir() ' handy for dx, dy, da random directions pos or neg
if rnd(3) = 2 then
rdir = 1
else
rdir = -1
end if
end function
sub demo1()
setcaption("Star fill demo for up to 15 point stars")
npoints = 3
while npoints < 16
cls
pAngle = 360 / nPoints : pAngle2 = pAngle/2
aDir =2: cDir = 2
c=0 : ang = 0 : cc = 0
while c < 180
c += 1
ang += aDir
if ang > pAngle then : ang = pAngle : aDir *= -1 : end if
if ang < 0 then : ang = 0 : aDir *= -1 : end if
cc += cDir
if cc > pAngle2 then : cc=pAngle2 : cDir *= -1 : end if
if cc < 0 then : cc=0 : cDir *= -1 : end if
ccc = cc/pAngle2 * 255
ink(rgb(ccc, ccc, .5 * (255 - cc)) )
star( cx, cy, 100, 350, npoints, ang, 0 )
star( cx, cy, 40, 100, npoints, -ang + pAngle2, 1 )
ink(0x00aa88)
text(10, 10, 20, str(nPoints) + " Point Stars")
screenswap
wait(40)
wend
nPoints += 3
wend
end sub
sub demo2()
setcaption("Star seeding... move mouse around to spread seeds...")
nb = 100
dim bx[nb], by[nb], bdx[nb], bdy[nb], bc[nb]
tm = 1000
dim tx[tm], ty[tm], tir[tm], tor[tm], tnp[tm], tao[tm], tad[tm], tf[tm], tc[tm]
tstart = 1
while key(27) = 0
cls
nxt = rand(0, nb)
bx[nxt] = mouseX
by[nxt] = mouseY
bdx[nxt] = rand(-4, 4)
bdy[nxt] = rand(5, 1)
bc[nxt] = rclr()
wait(20)
for i = 0 to nb
if bdy[i] then
ink(bc[i])
fillellipse( bx[i], by[i], 9, 5)
bx[i] = bx[i] + bdx[i] + rand(0, 2)
by[i] = by[i] + bdy[i]
if bx[i] < 0 or bx[i] > xmax or by[i] < 0 or by[i] > ymax then
bdy[i] = 0
if bx[i] > 0 and bx[i] < xmax then
tx[tstart] = bx[i] - bdx[i]
ty[tstart] = ymax
tir[tstart] = rand(2, 9)
tor[tstart] = rand(1, 9) * tir[tstart] + tir[tstart]
tnp[tstart] = rand(3, 10)
tao[tstart] = rand(0, 360)
tad[tstart] = rdir()
tc[tstart] = bc[i]
tf[tstart] = rand(0, 1)
tstart += 1
if tstart > tm then : tstart = 0 : end if
end if
end if
end if
next
for i = 0 to tm
if tx[i] <> 0 or ty[i] <> 0 then
ink(tc[i])
star( tx[i], ty[i], tir[i], tor[i], tnp[i], tao[i], tf[i] )
if ty[i] > -100 then
ty[i] = ty[i] - 1
tao[i] = tao[i] + tad[i] * 3
end if
end if
next
screenswap
wait(2)
wend
end sub
demo1
demo2
-
And one from SmallBASIC that can draw lines close together without as many holes:
'Star Maker another demo.bas SmallBASIC 0.12.6 [B+=MGA] 2016-06-03
'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
'demo
npoints = 3
cx = xmax / 2 : cy = ymax / 2
while npoints < 17
cls
pAngle = 360 / nPoints
pAngle2 = pAngle / 2
aDir = .1
cDir = .1
c = 0
while c<3600
c ++
ang += aDir
if ang > pAngle then ang = pAngle : aDir *= -1
if ang < 0 then ang = 0 : aDir *= -1
cc += cDir
if cc > pAngle2 then cc = pAngle2 : cDir *= -1
if cc < 0 then cc=0 : cDir *= -1
ccc = cc / pAngle2 * 255
color rgb(ccc, ccc, .5 * (255 - cc))
star cx, cy, 100, 350, npoints, ang, 0
star cx, cy, 40, 100, npoints, -ang + pAngle2, 1
showpage
delay 1
wend
pause
nPoints ++
wend
-
Star maker fed some plasma:
'Star Maker on plasma.bas SmallBASIC 0.12.6 [B+=MGA] 2016-06-04
'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
'demo
npoints = 3
cx = xmax / 2 : cy = ymax / 2
const a=127
while npoints < 18
cls
b = rnd ^ 2 : c = rnd ^ 2 : d = rnd ^ 2
for r = 1 to 100
color RGB(a + a * sin(b * r), a + a * sin(c * r), a + a * sin(d * r))
star cx, cy, r, r * 3.5, npoints, ang, 0
next
showpage
delay 3000
npoints ++
if npoints > 17 then npoints = 3
wend
-
Very impressive.