Basicprogramming(.org) > General questions and discussions
Celtic Knot Challenge
B+:
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.
--- Code: ---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
--- End code ---
The corners are nice and round, more natural:
B+:
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).
--- Code: ---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
--- End code ---
B+:
Here is SmallBASIC version of Knot #3, almost identical to QB64:
--- Code: ---'"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
--- End code ---
B+:
And a JB version:
--- Code: ---'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
--- End code ---
B+:
No more eyeballing in the bridges, it's all done with code but it is very temperamental.
--- Code: ---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
--- End code ---
Navigation
[0] Message Index
[*] Previous page
Go to full version