Author Topic: Celtic Knot Challenge  (Read 363 times)

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Celtic Knot Challenge
« on: 04. July 2019, 02:59:56 »
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
« Last Edit: 04. July 2019, 17:12:00 by B+ »

ZXDunny

  • Sr. Member
  • ****
  • Posts: 270
    • View Profile
Re: Celtic Knot Challence
« Reply #1 on: 04. July 2019, 12:31:22 »
I'm lazy, so if you could outline the algorithm I'll definitely give that a go :)

Cybermonkey

  • Administrator
  • Hero Member
  • *****
  • Posts: 671
    • View Profile
    • Home of EGSL
Re: Celtic Knot Challence
« Reply #2 on: 04. July 2019, 13:56:24 »
I'm lazy, so if you could outline the algorithm I'll definitely give that a go :)
+1  ;D
Best regards,
Cybermonkey

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #3 on: 04. July 2019, 16:34:53 »
Sorry, it is time and patience exercise that I know of:

Code: [Select]
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.

Code: [Select]
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."
« Last Edit: 04. July 2019, 17:16:49 by B+ »

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #4 on: 05. July 2019, 16:07:11 »
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.

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #5 on: 06. July 2019, 16:37:12 »
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:


B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #6 on: 06. July 2019, 16:38:17 »
And here is one with more open ended rings:

ZXDunny

  • Sr. Member
  • ****
  • Posts: 270
    • View Profile
Re: Celtic Knot Challenge
« Reply #7 on: 07. July 2019, 10:47:57 »
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

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #8 on: 08. July 2019, 00:02:48 »
I'm afraid I found the hard way to do it.

For your amusement here is my QB64 v1.3 code:

Code: [Select]
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!

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #9 on: 11. July 2019, 22:20:00 »
OK here is code to screen shot at start of this thread:
Code: [Select]
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


B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #10 on: 12. July 2019, 15:27:04 »
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: [Select]
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:
« Last Edit: 12. July 2019, 15:32:55 by B+ »

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #11 on: 13. July 2019, 01:59:50 »
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: [Select]
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

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #12 on: 13. July 2019, 03:52:11 »
Here is SmallBASIC version of Knot #3, almost identical to QB64:
Code: [Select]
'"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

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #13 on: 13. July 2019, 03:53:56 »
And a JB version:
Code: [Select]
'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

B+

  • Hero Member
  • *****
  • Posts: 846
    • View Profile
Re: Celtic Knot Challenge
« Reply #14 on: 21. July 2019, 02:13:48 »
No more eyeballing in the bridges, it's all done with code but it is very temperamental.
Code: [Select]
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