RetroBASIC
Basicprogramming(.org) => General questions and discussions => Topic started by: B+ on July 04, 2019, 12:59:56 AM
-
Anyone else want to try this:
EDIT: title of thread.
I think I ruined my eyes, getting all start and end angles for arcs. Ruined eyes in turn makes it hard to detect typos, assuming you know how to spell the word in first place :D
-
I'm lazy, so if you could outline the algorithm I'll definitely give that a go :)
-
I'm lazy, so if you could outline the algorithm I'll definitely give that a go :)
+1 ;D
-
Sorry, it is time and patience exercise that I know of:
OPTION _EXPLICIT
_TITLE "Vince Celtic Challenge Skeleton"
CONST xmax = 1200, ymax = 700, pi = 3.14159265
CONST xc = xmax / 2, yc = ymax / 2
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
celticKnot xc, yc, 30
SLEEP
SUB celticKnot (xc, yc, thick)
DIM distr, r, r1, hex, hd2, nHex, x0, y0, c AS _UNSIGNED LONG
distr = 5 * thick
r = 4 * thick
r1 = 3 * thick
hex = pi * 2 / 6
hd2 = hex / 2
FOR nHex = 1 TO 6
IF nHex <= 2 THEN c = &HFFFFFFFF ELSE c = &HFF444444
'circles with origins in main circle
x0 = xc + distr * COS(nHex * hex - hd2)
y0 = yc + distr * SIN(nHex * hex - hd2)
'outer radius
CIRCLE (x0, y0), r, c
'inner radius
CIRCLE (x0, y0), r1, c
' circles with outside origins
x0 = xc + (2 * distr - 1.5 * thick) * COS(nHex * hex)
y0 = yc + (2 * distr - 1.5 * thick) * SIN(nHex * hex)
IF nHex = 1 THEN c = &HFF0000FF ELSE c = &HFF444444
'outer radius
CIRCLE (x0, y0), r, c
'inner radius
CIRCLE (x0, y0), r1, c
NEXT
END SUB
This code draws the circle "skeleton" from which I eyeballed 12 Arcs with 12 Start Angles and 12 End Angles for an Arc Sub to draw in one "inside" circle ring and one "outside" ring. The 2nd inside ring highlighted is there to help show where bridges go on the overlap "inner" rings. Once that set is ready just repeat 6 times around the origin.
SUB arc (x, y, r, raStart, raStop, c AS _UNSIGNED LONG)
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
DIM al, a
IF raStop < raStart THEN
arc x, y, r, raStart, _PI(2), c
arc x, y, r, 0, raStop, c
ELSE
' modified to easier way suggested by Steve
'Why was the line method not good? I forgot.
al = _PI * r * r * (raStop - raStart) / _PI(2)
FOR a = raStart TO raStop STEP 1 / al
PSET (x + r * COS(a), y + r * SIN(a)), c
NEXT
END IF
END SUB
I was thinking I might automate the arc data by point and click with mouse for the start and end angles of arcs because the 2nd part of the challenge or extra credit goes to being able to change the width of the rings.
EDIT: Sorry for misspelling of Thread Title
Update: Apparently one can do everything mathematically given 3 radii and "width to render the image."
-
To eliminate eye-balling start and end arcs, I have worked up code for the 2 points intersect of 2 circles when they do intersect.
Hopefully this will allow me to draw a variety of ring widths with math only.
-
Success! sort of...
I hit a wall with Circle Intersect that returns 2 points where 2 circles intersect: which point is which for assigning to a variable?
Fixed by translating the points position to a standard variable map if the circle they came had 0 rotation.
Anyway now I can draw fat and thin rings with circles more open or closed:
-
And here is one with more open ended rings:
-
Very nice, B+ :)
I'm working on my celtic knots demo right now - it's different to yours but still looks pretty nice. Unfortunately I made several updates to the editor in SpecBAS so whenever I use it I find bugs that need fixing, so progress is slow :D
-
I'm afraid I found the hard way to do it.
For your amusement here is my QB64 v1.3 code:
OPTION _EXPLICIT
_TITLE "Celtic Challenge Advanced Sub" 'B+ 2019-07-06 develop as a sub
' parameters are x, y origin, radius of Knot, thicknes of rings, border color and fill color
' is there a max radius of knot?
CONST xmax = 700, ymax = 700, pi = 3.14159265
CONST xc = xmax / 2, yc = ymax / 2
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
DIM knot, thick, w$
WHILE 1
CLS
INPUT "Enter knot size, 20 to 150 best "; knot
INPUT "Enter ring thickness, 1 to 20% knot best ", thick
INPUT "Enter f to fill in with green, best not to fill when thickness < %5 knot "; w$
IF w$ = "f" THEN celticKnot xc, yc, knot, thick, &HFFFFFF00, &HFF00BB00 ELSE celticKnot xc, yc, knot, thick, &HFFFFFF00, 0
INPUT "press enter to cont... "; w$
_DISPLAY
WEND
'the max thickness for the knotRadius is .25 * knotRadius, ideal max is about 20%
' use 0 for fill color to skip PAINT jobs, recommended for small or thin knots
SUB celticKnot (xc, yc, knotR, ringThick, outline AS _UNSIGNED LONG, fill AS _UNSIGNED LONG)
DIM r, r1, hex, hd2, nHex
'a good naming system is crucial i/o = inner/outer circle,
'p1/m1 plus1/minus1 (actually it's plus and minus 1/2 for outer rings)
DIM xi, yi, xim1, yim1, xip1, yip1, xom1, yom1, xop1, yop1
'points of interest
DIM xm1, xm2, xm3, xm4, xm5, xm6, xm7, xm9, xm10, xm12
DIM ym1, ym2, ym3, ym4, ym5, ym6, ym7, ym9, ym10, ym12
DIM xn1, xn2, xn3, xn4, xn5, xn6, xn8, xn9, xn10, xn11
DIM yn1, yn2, yn3, yn4, yn5, yn6, yn8, yn9, yn10, yn11
DIM xp1, xp2, xp3, xp4, xp5, xp6, xp7, xp8
DIM xq1, xq2, xq3, xq4, xq5, xq6
DIM yp1, yp2, yp3, yp4, yp5, yp6, yp7, yp8
DIM yq1, yq2, yq3, yq4, yq5, yq6
r = .8 * knotR '4
r1 = r - ringThick '3 * ringThick ' 3
hex = pi * 2 / 6
hd2 = hex / 2
FOR nHex = 1 TO 6
'5 circle origin sets
'inner ring before main ring
xim1 = xc + knotR * COS((nHex - 1) * hex - hd2)
yim1 = yc + knotR * SIN((nHex - 1) * hex - hd2)
'main inner ring to draw up
xi = xc + knotR * COS(nHex * hex - hd2)
yi = yc + knotR * SIN(nHex * hex - hd2)
'inner ring after main
xip1 = xc + knotR * COS((nHex + 1) * hex - hd2)
yip1 = yc + knotR * SIN((nHex + 1) * hex - hd2)
'outer ring before main ring
xom1 = xc + (2 * knotR - 1.5 * ringThick) * COS((nHex - 1) * hex)
yom1 = yc + (2 * knotR - 1.5 * ringThick) * SIN((nHex - 1) * hex)
'outer ring after main ring
xop1 = xc + (2 * knotR - 1.5 * ringThick) * COS(nHex * hex)
yop1 = yc + (2 * knotR - 1.5 * ringThick) * SIN(nHex * hex)
'working main ring from 0 to 2*pi one segment at a time
'first point of interest on main is out circle /\ out circle of op1
intersect2Circles xi, yi, r, xop1, yop1, r, xm1, ym1, xm4, ym4
intersect2Circles xi, yi, r, xop1, yop1, r1, xm2, ym2, xm3, ym3
intersect2Circles xi, yi, r, xop1, yop1, r1, xm2, ym2, xm3, yn3
intersect2Circles xi, yi, r1, xop1, yop1, r1, xn2, yn2, xn3, yn3
minorArc xi, yi, r, rAngle(xi, yi, xm1, ym1), rAngle(xi, yi, xm3, ym3), outline
minorArc xi, yi, r1, rAngle(xi, yi, xn2, yn2), rAngle(xi, yi, xn3, yn3), outline
'inside main outside po1
intersect2Circles xi, yi, r1, xop1, yop1, r, xn1, yn1, xn4, yn4
'outside main with outside im1
intersect2Circles xi, yi, r, xim1, yim1, r, xm5, ym5, xm10, ym10
'inside main outside im1
intersect2Circles xi, yi, r1, xim1, yim1, r, xn5, yn5, xn10, yn10
minorArc xi, yi, r, rAngle(xi, yi, xm4, ym4), rAngle(xi, yi, xm5, ym5), outline
minorArc xi, yi, r1, rAngle(xi, yi, xn4, yn4), rAngle(xi, yi, xn5, yn5), outline
'outside main to inside im1
intersect2Circles xi, yi, r, xim1, yim1, r1, xm6, ym6, xm9, ym9
'inside main to inside im1
intersect2Circles xi, yi, r1, xim1, yim1, r1, xn6, yn6, xn9, yn9
minorArc xi, yi, r, rAngle(xi, yi, xm6, ym6), rAngle(xi, yi, xm9, ym9), outline
minorArc xi, yi, r1, rAngle(xi, yi, xn6, yn6), rAngle(xi, yi, xn9, yn9), outline
'outer main to outer om1
intersect2Circles xi, yi, r, xom1, yom1, r, xm7, ym7, xm12, ym12
'inner main to inner om1
intersect2Circles xi, yi, r1, xom1, yom1, r1, xn8, yn8, xn11, yn11
minorArc xi, yi, r, rAngle(xi, yi, xm10, ym10), rAngle(xi, yi, xm12, ym12), outline
minorArc xi, yi, r1, rAngle(xi, yi, xn10, yn10), rAngle(xi, yi, xn11, yn11), outline
'now for the two that fold inward
'outer op1 to outer ip1
intersect2Circles xop1, yop1, r, xip1, yip1, r, xp1, yp1, xp4, yp4
'outer op1 to inner p1
intersect2Circles xop1, yop1, r, xip1, yip1, r1, xp2, yp2, xp3, yp3
'inner op1 to inner p1
intersect2Circles xop1, yop1, r1, xip1, yip1, r1, xq2, yq2, xq3, yq3
minorArc xop1, yop1, r, rAngle(xop1, yop1, xp1, yp1), rAngle(xop1, yop1, xp3, yp3), outline
minorArc xop1, yop1, r1, rAngle(xop1, yop1, xq2, yq2), rAngle(xop1, yop1, xq3, yq3), outline
'inner op1 outer inner p1
intersect2Circles xop1, yop1, r1, xip1, yip1, r, xq1, yq1, xq4, yq4
minorArc xop1, yop1, r, rAngle(xop1, yop1, xp4, yp4), rAngle(xop1, yop1, xm1, ym1), outline
'last test?
minorArc xop1, yop1, r1, rAngle(xop1, yop1, xq4, yq4), rAngle(xop1, yop1, xn1, yn1), outline
'outer om1 to outer outer main
intersect2Circles xom1, yom1, r, xi, yi, r, xp5, yp5, xp8, yp8
'inner om1 to inner main
intersect2Circles xom1, yom1, r1, xi, yi, r1, xq5, yq5, xq6, yq6
'outer om1to inner main
intersect2Circles xom1, yom1, r, xi, yi, r1, xp6, yp6, xp7, yp7
minorArc xom1, yom1, r, rAngle(xom1, yom1, xp5, yp5), rAngle(xom1, yom1, xp7, yp7), outline
minorArc xom1, yom1, r1, rAngle(xom1, yom1, xq5, yq5), rAngle(xom1, yom1, xq6, yq6), outline
NEXT
IF fill THEN
DIM px, py, midR
midR = (r + r1) / 2 + .5
FOR nHex = 1 TO 6
'circles with origins in main circle
'main inner ring to draw up
xi = xc + knotR * COS(nHex * hex - hd2)
yi = yc + knotR * SIN(nHex * hex - hd2)
'4 paint points
px = xi + midR * COS(nHex * hex + .1 * pi)
py = yi + midR * SIN(nHex * hex + .1 * pi)
'CIRCLE (px, py), 1, fill
PAINT (px, py), fill, outline
px = xi + midR * COS(nHex * hex + .7 * pi)
py = yi + midR * SIN(nHex * hex + .7 * pi)
'CIRCLE (px, py), 1, fill
PAINT (px, py), fill, outline
px = xi + midR * COS(nHex * hex + 1.3 * pi)
py = yi + midR * SIN(nHex * hex + 1.3 * pi)
'CIRCLE (px, py), 1, fill
PAINT (px, py), fill, outline
px = xi + midR * COS(nHex * hex + 1.7 * pi)
py = yi + midR * SIN(nHex * hex + 1.7 * pi)
'CIRCLE (px, py), 1, fill
PAINT (px, py), fill, outline
NEXT
END IF
END SUB
'given a circles origin and point on the circumference return the arc measure of that point
FUNCTION rAngle (coX, coY, circumX, circumY)
rAngle = _ATAN2(circumY - coY, circumX - coX)
IF rAngle < 0 THEN rAngle = rAngle + _PI(2)
END FUNCTION
'given two arc angles I want the one that draws the smaller arc drawn
SUB minorArc (x, y, r, ra1, ra2, c AS _UNSIGNED LONG)
DIM raStart, raStop
'which has smaller arc measure
IF ra1 < ra2 THEN
IF ra2 - ra1 < _PI THEN raStart = ra1: raStop = ra2 ELSE raStart = ra2: raStop = ra1
ELSE
IF ra1 - ra2 < _PI THEN raStart = ra2: raStop = ra1 ELSE raStart = ra1: raStop = ra2
END IF
arc x, y, r, raStart, raStop, c
END SUB
SUB intersect2Circles (x1, y1, r1, x2, y2, r2, ix1, iy1, ix2, iy2)
'x1, y1 origin of circle 1 with radius r1
'x2, y2 origin of circle 2 with radius r2
'ix1, iy1 is the first point of intersect
'ix2, iy2 is the 2nd point of intersect
'if ix1 = ix2 = iy1 = iy2 = 0 then no points returned
DIM d, a, h, Px, Py, offset, rang1, rang2
d = distance(x1, y1, x2, y2) 'distance between two origins
IF r1 + r2 < d THEN
'PRINT "The circles are too far apart to intersect.": END
'some signal ??? if ix1 = ix2 = iy1 = iy2 = 0 then no points returned
ix1 = 0: ix2 = 0: iy1 = 0: iy2 = 0
EXIT SUB
END IF
IF (d < r1 AND r2 + d < r1) OR (d < r2 AND r1 + d < r2) THEN ' no intersect
ix1 = 0: ix2 = 0: iy1 = 0: iy2 = 0
EXIT SUB
END IF
'results
a = (r1 ^ 2 - r2 ^ 2 + d ^ 2) / (2 * d)
Px = x1 + a * (x2 - x1) / d
Py = y1 + a * (y2 - y1) / d
h = (r1 ^ 2 - a ^ 2) ^ .5
ix1 = INT(Px - h * (y2 - y1) / d)
iy1 = INT(Py + h * (x2 - x1) / d)
ix2 = INT(Px + h * (y2 - y1) / d)
iy2 = INT(Py - h * (x2 - x1) / d)
''getting the order of points matched to varaible labels
offset = rAngle(xc, yc, x1, y1)
rang1 = rAngle(x1, y1, ix1, iy1) - offset
IF rang1 < 0 THEN rang1 = rang1 + 2 * pi
rang2 = rAngle(x1, y1, ix2, iy2) - offset
IF rang2 < 0 THEN rang2 = rang2 + 2 * pi
IF rang2 < rang1 THEN SWAP ix1, ix2: SWAP iy1, iy2
END SUB
SUB arc (x, y, r, raStart, raStop, c AS _UNSIGNED LONG)
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
DIM al, a
IF raStop < raStart THEN
arc x, y, r, raStart, _PI(2), c
arc x, y, r, 0, raStop, c
ELSE
' modified to easier way suggested by Steve
'Why was the line method not good? I forgot.
al = _PI * r * r * (raStop - raStart) / _PI(2)
FOR a = raStart TO raStop STEP 1 / al
PSET (x + r * COS(a), y + r * SIN(a)), c
NEXT
END IF
END SUB
FUNCTION rrnd (n1, n2) 'return real number between
rrnd = (n2 - n1) * RND + n1
END FUNCTION
FUNCTION distance (x1, y1, x2, y2)
distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
END FUNCTION
What is that? over 70 variables in main sub!
-
OK here is code to screen shot at start of this thread:
OPTION _EXPLICIT
_TITLE "Vince Celtic Challenge Skeleton"
CONST xmax = 1200, ymax = 700, pi = 3.14159265
CONST xc = xmax / 2, yc = ymax / 2
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
celticKnot xc, yc, 30
SLEEP
SUB celticKnot (xc, yc, thick)
DIM distr, r, r1, hex, hd2, nHex, x0, y0, c AS _UNSIGNED LONG
distr = 5 * thick
r = 4 * thick
r1 = 3 * thick
hex = pi * 2 / 6
hd2 = hex / 2
FOR nHex = 1 TO 6
IF nHex <= 2 THEN c = &HFFFFFFFF ELSE c = &HFF444444
'circles with origins in main circle
x0 = xc + distr * COS(nHex * hex - hd2)
y0 = yc + distr * SIN(nHex * hex - hd2)
'outer radius
CIRCLE (x0, y0), r, c
'inner radius
CIRCLE (x0, y0), r1, c
' circles with outside origins
x0 = xc + (2 * distr - 1.5 * thick) * COS(nHex * hex)
y0 = yc + (2 * distr - 1.5 * thick) * SIN(nHex * hex)
IF nHex = 1 THEN c = &HFF0000FF ELSE c = &HFF444444
'outer radius
CIRCLE (x0, y0), r, c
'inner radius
CIRCLE (x0, y0), r1, c
NEXT
END SUB
-
A much easier approach, you don't have to eye ball to the pixel the start and end of arcs nor the heavy math to get 2 circle intersect points. This approach lays out the design shape and then draws "bridges" where the under/over passes are. Probably closer to how a human artist might do a Celtic Knot. Also don't worry about the inner and outer circle radii, just one radius for center of rings.
OPTION _EXPLICIT
_TITLE "Celtic Knot 2" ' B+ developed in JB, translated to QB64 2019-07-11
' Instead of worrying about 2 circles (or arcs of them) for one ring, draw one circle with really wide pen!
' Draw shape twice with Outline color then Fill color (smaller width) then lay "Bridges"
' over sections for underpass/overpass. Thanks to tsh73 for demo of this method with another Celtic Knot.
CONST xmax = 720, ymax = 720, pi = 3.14159265, xc = xmax / 2, yc = ymax / 2
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
COLOR , &HFF888888: CLS
DIM r
r = 350
knot2 xc, yc, r, 30, &HFFFFFF00, &HFF008800
CIRCLE (xc, yc), r
SLEEP
'for best results: 50+ (pixels) and up for knotR to see details
'max thickness for knotR (impreceise overall radius) is about 10%
SUB knot2 (x, y, knotR, thick, outlineC AS _UNSIGNED LONG, fillC AS _UNSIGNED LONG)
DIM hCenterX(6), hCenterY(6), hCX(6), hCY(6)
DIM w, hexAngle, h, hexD2, PD96, tD2
hexAngle = pi / 3: hexD2 = hexAngle / 2: PD96 = pi / 96 '<<<< all angles are refined to 96 parts of semicircle
w = knotR / 15: tD2 = thick / 2
FOR h = 1 TO 6
hCenterX(h) = x + 8 * w * COS(h * hexAngle + pi / 6)
hCenterY(h) = y + 8 * w * SIN(h * hexAngle + pi / 6)
hCX(h) = x + 14 * w * COS(h * hexAngle)
hCY(h) = y + 14 * w * SIN(h * hexAngle)
NEXT
FOR h = 1 TO 6
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + pi / 6 + PD96 * 7, h * hexAngle + pi / 6 + PD96 * 185, tD2, outlineC
penArc hCX(h), hCY(h), 6 * w, h * hexAngle + PD96 * 55, h * hexAngle + PD96 * 137, tD2, outlineC
NEXT
FOR h = 1 TO 6
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + pi / 6 + PD96 * 7, h * hexAngle + pi / 6 + PD96 * 185, tD2 - 1, fillC
penArc hCX(h), hCY(h), 6 * w, h * hexAngle + PD96 * 55, h * hexAngle + PD96 * 137, tD2 - 1, fillC
NEXT
'bridges
FOR h = 1 TO 6
'boarder color arc 7
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + PD96 * 51, h * hexAngle + PD96 * 58, tD2, outlineC
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + PD96 * 102, h * hexAngle + PD96 * 109, tD2, outlineC
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + PD96 * 148, h * hexAngle + PD96 * 155, tD2, outlineC
penArc hCX(h), hCY(h), 6 * w, h * hexAngle + PD96 * 83, h * hexAngle + PD96 * 90, tD2, outlineC
'fill color arc 2 before 3 after
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + PD96 * 49, h * hexAngle + PD96 * 61, tD2 - 1, fillC
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + PD96 * 99, h * hexAngle + PD96 * 111, tD2 - 1, fillC
penArc hCenterX(h), hCenterY(h), 6 * w, h * hexAngle + PD96 * 145, h * hexAngle + PD96 * 158, tD2 - 1, fillC
penArc hCX(h), hCY(h), 6 * w, h * hexAngle + PD96 * 80, h * hexAngle + PD96 * 92, tD2 - 1, fillC
NEXT
END SUB
SUB penArc (x, y, r, raStart, raStop, penWidth, c AS _UNSIGNED LONG)
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
DIM aStep, a
IF raStop < raStart THEN
penArc x, y, r, raStart, pi * 2, penWidth, c
penArc x, y, r, 0, raStop, penWidth, c
ELSE
aStep = 1 / (pi * r * 2)
FOR a = raStart TO raStop STEP aStep
fcirc x + r * COS(a), y + r * SIN(a), penWidth, c
NEXT
END IF
END SUB
'no built in circle fill sub with QB64 but this one is good!
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
DIM Radius AS INTEGER, RadiusError AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB
The corners are nice and round, more natural:
-
Applied easier method to a fancy sin/cos function for x, y coordinates st no straight lines nor circular arcs to use. It still took less time to eyeball bridges for overpasses than to apply intersect formulas or find exact pixel the arc ends are on (if we had circular arcs).
OPTION _EXPLICIT
_TITLE "Celtic Knot 3" ' B+ 2019-07-12
' To demo Celtic Knot mastery, attempt another one!
CONST xmax = 720, ymax = 720, pi = 3.14159265
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
DIM rr, w$
FOR rr = 30 TO 350 STEP 20
CLS
Knot3 xmax / 2, ymax / 2, rr, .12 * rr, &HFFFFFFFF, &HFFFF000088
CIRCLE (xmax / 2, ymax / 2), rr, &HFFFFFF00
INPUT "OK ..."; w$
NEXT
SLEEP
'KnotR tested OK from 30 to 350, thick 1 to 13% knotR, at thick = 1 and 2 just see fillC.
SUB Knot3 (xc, yc, knotR, thick, borderC AS _UNSIGNED LONG, fillC AS _UNSIGNED LONG)
DIM p, r, s, t, br, fr, x, y
CONST pm2d3 = pi * 2 / 3 ' all crucial points are 1/3 circle symmetric
r = knotR / 2.6: p = 35 * pi * r: s = 2 * pi / p
br = thick / 2 'border radius
fr = br - 2
'outline whole design
FOR t = 0 TO 2 * _PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
'PSET (x, y)
fcirc x, y, br, borderC
'code to help me find where in the 0 to 2*PI points are
'IF t = 0 THEN fcirc x, y, 3, &HFF0000FF
'IF ABS(t - pi) < .0025 THEN fcirc x, y, 3, &HFF000066
NEXT
'fill in design, same as above only smaller circle fills
FOR t = 0 TO 2 * _PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
'PSET (x, y)
fcirc x, y, fr, fillC
NEXT
'over bridges borders, locate over the top passes and draw circles over the over pass
FOR t = 0 TO 2 * _PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 51 / 384 - pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 111 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 111 / 384 - pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 424 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 424 / 384 - pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 680 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .11 THEN fcirc x, y, br, borderC
NEXT
'over bridges fills , now draw farther up and down the bidge work the fill color
FOR t = 0 TO 2 * _PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 51 / 384 - pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 111 / 384) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 111 / 384 - pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 424 / 384) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 424 / 384 - pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 680 / 384) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .14 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .14 THEN fcirc x, y, fr, fillC
NEXT
END SUB
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
DIM Radius AS INTEGER, RadiusError AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB
-
Here is SmallBASIC version of Knot #3, almost identical to QB64:
'"Celtic Knot 3" ' B+ 2019-07-12 from QB64
' To demo Celtic Knot mastery, attempt another one!
borderColor = RGB(255, 255, 0)
fillColor = RGB(0, 128, 0)
moreColor = RGB(160, 160, 255)
FOR rr = 30 TO 350 STEP 20
CLS
Knot3 xmax / 2, ymax / 2, rr, .12 * rr, borderColor, fillColor, moreColor
CIRCLE xmax / 2, ymax / 2, rr, 1, rgb(128, 128, 128)
INPUT "OK ..."; w$
NEXT
'KnotR tested OK from 30 to 350, thick 1 to 13% knotR, at thick = 1 and 2 just see fillC.
SUB Knot3 (xc, yc, knotR, thick, borderC, fillC, middleC)
'DIM p, r, s, t, br, fr, x, y
pm2d3 = pi * 2 / 3 ' all crucial points are 1/3 circle symmetric
r = knotR / 2.6: p = 35 * pi * r: s = 2 * pi / p
br = thick / 2 'border radius
fr = br - 4
mr = fr - 4
'outline whole design
FOR t = 0 TO 2 * PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
'PSET (x, y)
fcirc x, y, br, borderC
'code to help me find where in the 0 to 2*PI points are
'IF t = 0 THEN fcirc x, y, 3, &HFF0000FF
'IF ABS(t - pi) < .0025 THEN fcirc x, y, 3, &HFF000066
NEXT
'fill in design, same as above only smaller circle fills
FOR t = 0 TO 2 * PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
'PSET (x, y)
fcirc x, y, fr, fillC
NEXT
FOR t = 0 TO 2 * PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
'PSET (x, y)
fcirc x, y, mr, middleC
NEXT
'over bridges borders, locate over the top passes and draw circles over the over pass
FOR t = 0 TO 2 * PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 51 / 384 - pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 111 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 111 / 384 - pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 424 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 424 / 384 - pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 680 / 384) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .11 THEN fcirc x, y, br, borderC
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .11 THEN fcirc x, y, br, borderC
NEXT
'over bridges fills , now draw farther up and down the bidge work the fill color
FOR t = 0 TO 2 * PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 51 / 384 - pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 111 / 384) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 111 / 384 - pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 424 / 384) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 424 / 384 - pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 680 / 384) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .13 THEN fcirc x, y, fr, fillC
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .13 THEN fcirc x, y, fr, fillC
NEXT
FOR t = 0 TO 2 * PI STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 51 / 384 - pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 111 / 384) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 111 / 384 - pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 424 / 384) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 424 / 384 - pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 680 / 384) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .15 THEN fcirc x, y, mr, middleC
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .15 THEN fcirc x, y, mr, middleC
NEXT
END SUB
SUB fcirc (cX, cY, R, C)
circle cx, cy, r, 1, C filled
END SUB
-
And a JB version:
'Knot #3.txt for JB v2 bplus 2019-07-12 try fancy sin /cos equation for x, y coordinates
' To demo Celtic Knot mastery, attempt another one, no straight lines and no circular curves!
global pi, XMAX, YMAX
pi = 3.14159265
XMAX = 720 'full screen width
YMAX = 720
nomainwin
UpperLeftX = 300
UpperLeftY = 10
WindowWidth = XMAX + 8 'adjust +10 for screen frame plus slight white frame
WindowHeight = YMAX + 32 'add +32 for screen frame plus slight white frame
open "Knot #3" for graphics_nsb_nf as #gr '_nf =no full screen, _nsb =no scroll bars
#gr "trapclose [quit]"
#gr "down"
r = 135 : p = 35 * pi * r : s = 2 * pi / p 'stepper in all for loops
pm2d3 = pi * 2 / 3 ' all crucial points are 1/3 circle symmetric
xc = XMAX/2 : yc = YMAX/2
'outline whole design
#gr "color red"
#gr "size 40"
FOR t = 0 TO 2 * pi STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
#gr "set ";x;" ";y
NEXT
'fill in design, same as above only smaller circle fills
#gr "color blue"
#gr "size 26"
FOR t = 0 TO 2 * pi STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
#gr "set ";x;" ";y
NEXT
'another surprise fill!
#gr "color green"
#gr "size 12"
FOR t = 0 TO 2 * pi STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
#gr "set ";x;" ";y
NEXT
'over bridges borders, locate over the top passes and draw circles over the over pass
#gr "color red"
#gr "size 40"
FOR t = 0 TO 2 * pi STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 51 / 384 - pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384 - pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384 - pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .11 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .11 THEN #gr "set ";x;" ";y
NEXT
'over bridges fills , now draw farther up and down the bridge work the fill color
#gr "color blue"
#gr "size 26"
FOR t = 0 TO 2 * pi STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 51 / 384 - pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384 - pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384 - pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .13 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .13 THEN #gr "set ";x;" ";y
NEXT
'continue surprise fill over bridges still further than blue
#gr "color green"
#gr "size 12"
FOR t = 0 TO 2 * pi STEP s
x = xc + r * (COS(t) + COS(4 * t) / .7 + SIN(2 * t) / 12)
y = yc + r * (SIN(t) + SIN(4 * t) / .7 + COS(2 * t) / 12)
IF ABS(t - pi * 51 / 384) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 51 / 384 - pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 51 / 384 - 2 * pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384 - pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 111 / 384 - 2 * pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384 - pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 424 / 384 + 1 * pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384 + 2 * pm2d3) < .16 THEN #gr "set ";x;" ";y
IF ABS(t - pi * 680 / 384 + 1 * pm2d3) < .16 THEN #gr "set ";x;" ";y
NEXT
#gr "flush"
wait
[quit]
timer 0
close #gr
end
-
No more eyeballing in the bridges, it's all done with code but it is very temperamental.
OPTION _EXPLICIT
_TITLE "Knot Function of Angle" ' B+ 2019-07-18
' another attempt to get intersect points by computer rather than eyeball
CONST xmax = 740, ymax = 740, pi = 3.14159265
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 0
DIM x0, y0, r0, rThick, rFill 'for knot r is for equation, r1 is for thickness of rings, r2 is fill thicknes
x0 = xmax / 2: y0 = ymax / 2: r0 = 120: rThick = 4: rFill = 2
x0 = xmax / 2: y0 = ymax / 2: r0 = 100: rThick = 8: rFill = 4
knot xmax / 4, ymax / 4, 60, 15, 8, &HFF009900, &HFF0000FF, 1
knot 3 * xmax / 4, ymax / 4 + 35, 100, 8, 4, &HFFFFFF00, &HFFFF0000, 2
knot xmax / 4, ymax * 3 / 4, 98, 4, 1, &HFFFFFFFF, &HFF009900, 3
knot xmax * 3 / 4, ymax * 3 / 4, 90, 4, 2, &HFF0000FF, &HFF00BBBB, 4
SUB knot (xc, yc, r, r1, r2, border AS _UNSIGNED LONG, fill AS _UNSIGNED LONG, functionNum)
DIM counts(_WIDTH, _HEIGHT) AS INTEGER, ang(_WIDTH, _HEIGHT) AS SINGLE
DIM a, x AS INTEGER, y AS INTEGER, stepper 'for plotting
stepper = 1 / (2 * pi * r) 'how close to step 'orig 2*pi
'first pass draw in outline
FOR a = 0 TO 2 * pi - 2 * stepper STEP stepper 'collect data
SELECT CASE functionNum
CASE 1: FofA xc, yc, r, a, x, y
CASE 2: FofA2 xc, yc, r, a, x, y
CASE 3: FofA3 xc, yc, r, a, x, y
CASE 4: FofA4 xc, yc, r, a, x, y
END SELECT
IF counts(x, y) <> 0 THEN
IF ABS(ang(x, y) - a) > pi / 12 THEN 'not too close pi/12 orig
counts(x, y) = counts(x, y) + 1 'hopefully
ang(x, y) = a 'update xy position with latest angle
END IF
ELSE
counts(x, y) = 1: ang(x, y) = a
fcirc x, y, r1, border
END IF
NEXT
DIM intersects(100, 1) AS INTEGER, ii AS INTEGER, i, flag
'next pass draw in fill
FOR y = 0 TO ymax
FOR x = 0 TO xmax
IF counts(x, y) THEN fcirc x, y, r2, fill
IF counts(x, y) > 1 THEN
IF ii > 0 THEN
flag = 0
FOR i = 0 TO ii
IF ((intersects(i, 0) - x) ^ 2 + (intersects(i, 1) - y) ^ 2) ^ .5 < 2 THEN flag = 1: EXIT FOR
NEXT
IF flag = 0 THEN
intersects(ii, 0) = x
intersects(ii, 1) = y
ii = ii + 1
END IF
ELSE
intersects(ii, 0) = x
intersects(ii, 1) = y
ii = ii + 1
END IF
END IF
NEXT
NEXT
'For each intersect there is am angle it goes over and an angle it goes under
' looking at figure from angle = 0, it alternates over, under, over, under....;
' its the over angles that need the bridges. How to find the over angles?
DIM lasta, toggle, b, xx AS INTEGER, yy AS INTEGER
FOR a = 0 TO 2 * pi - 2 * stepper STEP stepper 'collect data
SELECT CASE functionNum
CASE 1: FofA xc, yc, r, a, x, y
CASE 2: FofA2 xc, yc, r, a, x, y
CASE 3: FofA3 xc, yc, r, a, x, y
CASE 4: FofA4 xc, yc, r, a, x, y
END SELECT
FOR i = 0 TO ii - 1
IF x = intersects(i, 0) AND y = intersects(i, 1) AND ABS(a - lasta) > pi / 24 THEN
toggle = (toggle + 1) MOD 2
IF toggle THEN 'save every other angle as positive for the overpasses
'build a bridge
FOR b = a - 3 * pi / 96 TO a + 3 * pi / 96 STEP stepper
SELECT CASE functionNum
CASE 1: FofA xc, yc, r, b, xx, yy
CASE 2: FofA2 xc, yc, r, b, xx, yy
CASE 3: FofA3 xc, yc, r, b, xx, yy
CASE 4: FofA4 xc, yc, r, b, xx, yy
END SELECT
fcirc xx, yy, r1, border
NEXT
FOR b = a - 4 * pi / 96 TO a + 4 * pi / 96 STEP stepper
SELECT CASE functionNum
CASE 1: FofA xc, yc, r, b, xx, yy
CASE 2: FofA2 xc, yc, r, b, xx, yy
CASE 3: FofA3 xc, yc, r, b, xx, yy
CASE 4: FofA4 xc, yc, r, b, xx, yy
END SELECT
fcirc xx, yy, r2, fill
NEXT
END IF
lasta = a
EXIT FOR
END IF
NEXT
NEXT
END SUB
SUB FofA (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
xReturn = INT(xc + r * (COS(a) + COS(4 * a) / .7 + SIN(2 * a) / 12))
yReturn = INT(yc + r * (SIN(a) + SIN(4 * a) / .7 + COS(2 * a) / 12))
END SUB
SUB FofA2 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
xReturn = xc + r * (COS(a) + COS(5 * a) / 1.6 + SIN(2 * a) / 3)
yReturn = yc + r * (SIN(a) + SIN(5 * a) / 1.6 + COS(2 * a) / 3)
END SUB
SUB FofA3 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
xReturn = xc + r * (COS(a) + COS(7 * a) / 2 + SIN(2 * a) / 3)
yReturn = yc + r * (SIN(a) + SIN(7 * a) / 2 + COS(2 * a) / 3)
END SUB
'for function number 4, the following works best
SUB FofA4 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
xReturn = xc + r * (COS(a) + COS(4 * a) / 2.9 + SIN(6 * a) / 2.1) '2.6 2.1 works
yReturn = yc + r * (SIN(a) + SIN(4 * a) / 2.9 + COS(6 * a) / 2.1) ' 2.7 2.2 better? 2.8 2.3 OK too 2.9 2.1 is it
END SUB
'''''' ================= failed: bridges too close or passes do not alternate , too many loops?
''''' Toggle commented function blocks to see some fancy loops tried
'SUB FofA4 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
' xReturn = xc + r * (COS(a) + COS(9 * a) / 2.5 + SIN(3 * a) / 2.6)
' yReturn = yc + r * (SIN(a) + SIN(9 * a) / 2.5 + COS(3 * a) / 2.6)
'END SUB
'SUB FofA4 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
' xReturn = xc + r * (COS(a) + COS(3 * a) / 2 + SIN(11 * a) / 2.7)
' yReturn = yc + r * (SIN(a) + SIN(3 * a) / 2 + COS(11 * a) / 2.7)
'END SUB
'SUB FofA4 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
' xReturn = xc + r * (COS(a) + COS(9 * a) / 2 + SIN(5 * a) / 2.5)
' yReturn = yc + r * (SIN(a) + SIN(9 * a) / 2 + COS(5 * a) / 2.5)
'END SUB
'SUB FofA4 (xc, yc, r, a AS SINGLE, xReturn AS INTEGER, yReturn AS INTEGER)
' xReturn = xc + r * (COS(a) + COS(5 * a) / 2.7 + SIN(6 * a) / 2)
' yReturn = yc + r * (SIN(a) + SIN(5 * a) / 2.7 + COS(6 * a) / 2)
'END SUB
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
DIM Radius AS INTEGER, RadiusError AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB