'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