RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on March 07, 2018, 07:56:47 PM
-
SmallBASIC version
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
while 1
cc1 = rgb(0, rnd*100 +50, 0)
cc2 = rgb(0, rnd*100 +50, 0)
xp = rnd * xmax
yp = rnd * ymax
size = int(rnd*100) + 10
ang = rnd*2*pi
color cc1
for r = 1 to size
drawShamrock xp+1, yp, r, ang
drawShamrock xp-1, yp, r, ang
drawShamrock xp, yp+1, r, ang
drawShamrock xp, yp-1, r, ang
drawShamrock xp+1, yp+1, r, ang
next
color cc2
for r = 1 to size
drawShamrock xp, yp, r, ang
next
showpage
delay 10
wend
pause
'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub myArc( xCenter, yCenter, arcRadius, dAStart, dAMeasure)
'notes:
'you may want to adjust size and color for line drawing
'using angle measures in degrees to match Just Basic ways with pie and piefilled
'this sub assumes drawing in a CW direction if dAMeasure positive
'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South
'dAStart is degrees to start Angle, due East is 0 degrees
'dAMeasure is degrees added (Clockwise) to dAstart for end of arc
rAngleStart = RAD(dAStart)
rAngleEnd = RAD(dAMeasure) + rAngleStart
Stepper = RAD(1/(.1 * arcRadius)) 'fixed
for rAngle = rAngleStart to rAngleEnd step Stepper
if rAngle = rAngleStart then
lastX = xCenter + arcRadius * cos(rAngle)
lastY = yCenter + arcRadius * sin(rAngle)
else
nextX = xCenter + arcRadius * cos(rAngle)
if nextX <= lastX then useX = nextX -1 else useX = nextX + 1
nextY = yCenter + arcRadius * sin(rAngle)
if nextY <= lastY then useY = nextY -1 else useY = nextY + 1
line lastX, lastY, nextX, nextY
lastX = nextX
lastY = nextY
end if
next
end sub
sub drawHeart( x, y, r, a)
local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
'clockwise from due East, the V
x1 = x + r * cos(a)
y1 = y + r * sin(a)
x2 = x + r * cos(a + pi/2)
y2 = y + r * sin(a + pi/2)
x3 = x + r * cos(a + pi)
y3 = y + r * sin(a + pi)
x4 = x + r * cos(a + 3*pi/2)
y4 = y + r * sin(a + 3*pi/2)
x5 = (x3 + x4)/2
y5 = (y3 + y4)/2
x6 = (x4 + x1)/2
y6 = (y4 + y1)/2
line x1, y1, x2, y2
line x2, y2, x3, y3
'left hump
myArc x5, y5, .5 * r * 2 ^ .5, deg(a) + 135, 180
'right hump
myArc x6, y6, .5 * r * 2 ^ .5, deg(a) + 225, 180
end sub
sub drawShamrock(x, y, r, a)
local x1, x2, x3, y1, y2, y3
x1 = x + r * cos(a + 3*pi/2)
y1 = y + r * sin(a + 3*pi/2)
x2 = x + r * cos(a + pi/6)
y2 = y + r * sin(a + pi/6)
x3 = x + r * cos(a + 5*pi/6)
y3 = y + r * sin(a + 5*pi/6)
drawHeart x1, y1, r, a
drawHeart x2, y2, r, a + 2*pi/3
drawHeart x3, y3, r, a + 4*pi/3
end sub
QB version
_TITLE "Happy St Patrick's Day by bplus 2018-03-07"
' from
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
CONST xmax = 1280
CONST ymax = 760
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 70, 0
WHILE 1
cc1&& = _RGB32(0, RND * 100 + 50, 0)
cc2&& = _RGB32(0, RND * 100 + 50, 0)
xp = RND * xmax
yp = RND * ymax
size = INT(RND * 100) + 10
ang = RND * _PI(2)
COLOR cc1&&
FOR r = 1 TO size
drawShamrock xp + 1, yp, r, ang
drawShamrock xp - 1, yp, r, ang
drawShamrock xp, yp + 1, r, ang
drawShamrock xp, yp - 1, r, ang
drawShamrock xp + 1, yp + 1, r, ang
NEXT
COLOR cc2&&
FOR r = 1 TO size
drawShamrock xp, yp, r, ang
NEXT
_DISPLAY
_LIMIT 20
WEND
'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
SUB myArc (xCenter, yCenter, arcRadius, dAStart, dAMeasure)
'notes:
'you may want to adjust size and color for line drawing
'using angle measures in degrees to match Just Basic ways with pie and piefilled
'this sub assumes drawing in a CW direction if dAMeasure positive
'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South
'dAStart is degrees to start Angle, due East is 0 degrees
'dAMeasure is degrees added (Clockwise) to dAstart for end of arc
rAngleStart = RAD(dAStart)
rAngleEnd = RAD(dAMeasure) + rAngleStart
Stepper = RAD(1 / (.1 * arcRadius)) 'fixed
FOR rAngle = rAngleStart TO rAngleEnd STEP Stepper
IF rAngle = rAngleStart THEN
lastX = xCenter + arcRadius * COS(rAngle)
lastY = yCenter + arcRadius * SIN(rAngle)
ELSE
nextX = xCenter + arcRadius * COS(rAngle)
IF nextX <= lastX THEN useX = nextX - 1 ELSE useX = nextX + 1
nextY = yCenter + arcRadius * SIN(rAngle)
IF nextY <= lastY THEN useY = nextY - 1 ELSE useY = nextY + 1
LINE (lastX, lastY)-(nextX, nextY)
lastX = nextX
lastY = nextY
END IF
NEXT
END SUB
SUB drawHeart (x, y, r, a)
'local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
'clockwise from due East, the V
x1 = x + r * COS(a)
y1 = y + r * SIN(a)
x2 = x + r * COS(a + _PI(1 / 2))
y2 = y + r * SIN(a + _PI(1 / 2))
x3 = x + r * COS(a + _PI)
y3 = y + r * SIN(a + _PI)
x4 = x + r * COS(a + 3 * _PI / 2)
y4 = y + r * SIN(a + 3 * _PI / 2)
x5 = (x3 + x4) / 2
y5 = (y3 + y4) / 2
x6 = (x4 + x1) / 2
y6 = (y4 + y1) / 2
LINE (x1, y1)-(x2, y2)
LINE (x2, y2)-(x3, y3)
'left hump
myArc x5, y5, .5 * r * 2 ^ .5, DEG(a) + 135, 180
'right hump
myArc x6, y6, .5 * r * 2 ^ .5, DEG(a) + 225, 180
END SUB
SUB drawShamrock (x, y, r, a)
'local x1, x2, x3, y1, y2, y3
x1 = x + r * COS(a + 3 * _PI / 2)
y1 = y + r * SIN(a + 3 * _PI / 2)
x2 = x + r * COS(a + _PI / 6)
y2 = y + r * SIN(a + _PI / 6)
x3 = x + r * COS(a + 5 * _PI / 6)
y3 = y + r * SIN(a + 5 * _PI / 6)
drawHeart x1, y1, r, a
drawHeart x2, y2, r, a + 2 * _PI / 3
drawHeart x3, y3, r, a + 4 * _PI / 3
END SUB
FUNCTION RAD (a)
RAD = _PI(a / 180)
END FUNCTION
FUNCTION DEG (a)
DEG = a * 180 / _PI
END FUNCTION
JB version
'from QB64
' _TITLE "Happy St Patrick's Day by bplus 2018-03-07"
' from
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
global H$, XMAX, YMAX, PI, DEG, RAD
H$ = "gr"
XMAX = 1200 '<======================================== actual drawing space needed
YMAX = 720 '<======================================== actual drawing space needed
PI = acs(-1)
DEG = 180 / PI
RAD = PI / 180
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2 'or delete if XMAX is 1200 or above
UpperLeftY = (720 - YMAX) / 2 'or delete if YMAX is 700 or above
open " Happy St Patrick's Day by bplus 2018-03-07" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "size 2"
WHILE 1
scan
cc1 = RND(0) * 100 + 50
cc2 = RND(0) * 100 + 50
xp = RND(0) * XMAX
yp = RND(0) * YMAX
sz = INT(RND(0) * 40) + 10
ang = RND(0) * PI*2
#gr "size 2"
call fore 0, cc1, 0
FOR r = 1 TO sz
scan
call drawShamrock xp +1, yp, r, ang
'call drawShamrock xp - 1, yp, r, ang
'call drawShamrock xp, yp + 1, r, ang
'call drawShamrock xp, yp - 1, r, ang
'call drawShamrock xp + 1, yp + 1, r, ang
NEXT
#gr "size 1"
call fore 0, cc2, 0
FOR r = 1 TO sz
scan
call drawShamrock xp, yp, r, ang
NEXT
WEND
wait
sub fore r, g, b
#gr "color ";r;" ";g;" ";b
end sub
sub aline x0, y0, x1, y1
#gr "line ";x0;" ";y0;" ";x1;" ";y1 'add 1 to end point
end sub
'Need line: #gr "trapclose quit"
sub quit H$
close #H$ '<=== this needs Global H$ = "gr"
end 'Thanks Facundo, close graphic wo error
end sub
'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub arc xCenter, yCenter, arcRadius, dAStart, dAMeasure
'notes:
'you may want to adjust size and color for line drawing
'using angle measures in degrees to match Just Basic ways with pie and piefilled
'this sub assumes drawing in a CW direction if dAMeasure positive
'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South
'dAStart is degrees to start Angle, due East is 0 degrees
'dAMeasure is degrees added (Clockwise) to dAstart for end of arc
rAngleStart = RAD * dAStart
rAngleEnd = RAD * dAMeasure + rAngleStart
Stepper = RAD / (.1 * arcRadius) 'fixed
for rAngle = rAngleStart to rAngleEnd step Stepper
if rAngle = rAngleStart then
lastX = xCenter + arcRadius * cos(rAngle)
lastY = yCenter + arcRadius * sin(rAngle)
else
nextX = xCenter + arcRadius * cos(rAngle)
if nextX <= lastX then useX = nextX -1 else useX = nextX + 1
nextY = yCenter + arcRadius * sin(rAngle)
if nextY <= lastY then useY = nextY -1 else useY = nextY + 1
#gr "line ";lastX;" ";lastY;" ";nextX;" ";nextY
lastX = nextX
lastY = nextY
end if
next
end sub
SUB drawHeart x, y, r, a
scan
'local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
'clockwise from due East, the V
x1 = x + r * COS(a)
y1 = y + r * SIN(a)
x2 = x + r * COS(a + PI / 2)
y2 = y + r * SIN(a + PI / 2)
x3 = x + r * COS(a + PI)
y3 = y + r * SIN(a + PI)
x4 = x + r * COS(a + 3 * PI / 2)
y4 = y + r * SIN(a + 3 * PI / 2)
x5 = (x3 + x4) / 2
y5 = (y3 + y4) / 2
x6 = (x4 + x1) / 2
y6 = (y4 + y1) / 2
#gr "line ";x1;" ";y1;" ";x2;" ";y2
#gr "line ";x2;" ";y2;" ";x3;" ";y3
'left hump
call arc x5, y5, .5 * r * 2 ^ .5, DEG*a + 135, 180
'right hump
call arc x6, y6, .5 * r * 2 ^ .5, DEG*a + 225, 180
END SUB
SUB drawShamrock x, y, r, a
'local x1, x2, x3, y1, y2, y3
scan
x1 = x + r * COS(a + 3 * PI / 2)
y1 = y + r * SIN(a + 3 * PI / 2)
x2 = x + r * COS(a + PI / 6)
y2 = y + r * SIN(a + PI / 6)
x3 = x + r * COS(a + 5 * PI / 6)
y3 = y + r * SIN(a + 5 * PI / 6)
call drawHeart x1, y1, r, a
call drawHeart x2, y2, r, a + 2 * PI / 3
call drawHeart x3, y3, r, a + 4 * PI / 3
END SUB
-
A Shamrock Slot Machine: How many Shamrocks will it take to get a 7 leafed one with 1 in 625 chance?
' Shamrock Luck.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-10
' from: QB64 version of Shamrock 2018-03-09.bas
' lessons learned with JB version 2018-03-09 tsh tips
' from N Leafed Shamrocks 2018-03-08
' Draw Angled Heart.bas SmallBASIC 0.12.11 (b+=mga) 2018-03-07
randomize timer
dim counts(7)
color 15, rgb(60, 30, 15)
cls
while nLeafs < 7
luck = rnd
if luck < 1 / 625 then
nLeafs = 7
elif luck < 1 / 125 then
nLeafs = 6
elif luck < 1 / 25
nLeafs = 5
elif luck < 1 / 5
nLeafs = 4
else
nLeafs = 3
fi
counts(nLeafs) = counts(nLeafs) + 1
counts(1) = counts(1) + 1
stat$ = str$(counts(3))
for i = 4 to 7
stat$ = stat$ + " : " + str$(counts(i))
next
stat$ = stat$ + " = " + str$(counts(1))
cc1 = rnd * 100 + 50
cc2 = rnd * 100 + 50
while abs(cc1 - cc2) < 30 'for contrast of 2 colors
cc2 = rnd * 100 + 50
wend
xp = rnd * (xmax - 100) + 50
yp = rnd * (ymax - 100) + 50
size = int(rnd * 40) + 10
ang = rnd * pi * 2
color rgb(0, cc1, 0)
drawShamrockN xp + 1, yp, size, ang, nLeafs, 1
color rgb(0, cc2, 0)
for r = 1 to size
drawShamrockN xp, yp, r, ang, nLeafs, 0
next
color 15
at 1, 1 : ? stat$ + " N Leafed Shamrocks, 1 in 625 chance for 7 Leafed Shamrock.
showpage
delay 10
wend
pause
sub drawHeart (x, y, r, rl, a, solid)
local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
'clockwise from due east, the v
x1 = x + r * cos(a)
y1 = y + r * sin(a)
x2 = x + rl * cos(a + pi / 2)
y2 = y + rl * sin(a + pi / 2)
x3 = x + r * cos(a + pi)
y3 = y + r * sin(a + pi)
x4 = x + r * cos(a + 3 * pi / 2)
y4 = y + r * sin(a + 3 * pi / 2)
x5 = (x3 + x4) / 2
y5 = (y3 + y4) / 2
x6 = (x4 + x1) / 2
y6 = (y4 + y1) / 2
if solid then
drawpoly [x1, y1, x2, y2, x3, y3, x4, y4, x1, y1] filled
circle x5, y5, .5 * r * 2 ^ .5 filled
circle x6, y6, .5 * r * 2 ^ .5 filled
else
line x1, y1, x2, y2
line x2, y2, x3, y3
'left hump
myArc x5, y5, .5 * r * 2 ^ .5, deg(a) + 135, 180
'right hump
myArc x6, y6, .5 * r * 2 ^ .5, deg(a) + 235, 180
end if
end sub
sub drawShamrockN (x, y, r, a, nleafed, solid)
local bigr, leaf, x1, y1
bigr = 2.11 * r * nleafed / (2 * pi)
for leaf = 0 to nleafed - 1
x1 = x + bigr * cos(a + leaf * 2 * pi / nleafed + 3 * pi / 2)
y1 = y + bigr * sin(a + leaf * 2 * pi / nleafed + 3 * pi / 2)
drawHeart x1, y1, r, bigr, a + leaf * 2 * pi / nleafed, solid
next
end sub
'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub myArc( xCenter, yCenter, arcRadius, dAStart, dAMeasure)
'notes:
'you may want to adjust size and color for line drawing
'using angle measures in degrees to match Just Basic ways with pie and piefilled
'this sub assumes drawing in a CW direction if dAMeasure positive
'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South
'dAStart is degrees to start Angle, due East is 0 degrees
'dAMeasure is degrees added (Clockwise) to dAstart for end of arc
rAngleStart = RAD(dAStart)
rAngleEnd = RAD(dAMeasure) + rAngleStart
Stepper = RAD(1/(.1 * arcRadius)) 'fixed
for rAngle = rAngleStart to rAngleEnd step Stepper
if rAngle = rAngleStart then
lastX = xCenter + arcRadius * cos(rAngle)
lastY = yCenter + arcRadius * sin(rAngle)
else
nextX = xCenter + arcRadius * cos(rAngle)
if nextX <= lastX then useX = nextX -1 else useX = nextX + 1
nextY = yCenter + arcRadius * sin(rAngle)
if nextY <= lastY then useY = nextY -1 else useY = nextY + 1
line lastX, lastY, nextX, nextY
lastX = nextX
lastY = nextY
end if
next
end sub
SmallBASIC has an arc sub but the handmade one draws better lines here.