One more pattern challenge

[Pete]

The original post was just a pattern challenge, but then Petr comes along and posts that dog collar thingy... with text! That got me hooked.  I wanted to figure out how to modify the statements to allow for a longer message, which I accomplished, because as you all know, I'm text challenged!

Pete

[bplus]

Hi Pete,

Apparently I am overlap challenged :D

It is a nice bit of code you've worked out.

[OldMoses]

I came real, real close.... if a black screen could be considered close. ;)

[SMcNeill]

I came real, real close.... if a black screen could be considered close. ;)

Why not?

After all, Windows considered a blue screen to be a working product...

[bplus]

I could not give up on overlap thing, got it now I think. The speedy DoubleRing did not work for pixel precision so back to old and even slower method (found a few holes):

Code: QB64: [Select]

1. _TITLE "One More Pattern Challenge matching Steves" 'bplus 2019-07-08
2. CONST xmax = 800, ymax = 760, PI = 3.141592653589793
3. SCREEN _NEWIMAGE(xmax, ymax, 32)
4. _SCREENMOVE 100, 0
5. DIM x, y, offset, side, n, i, pAngle, lastx, lasty, r, midx, midy, x0, y0, toggle
6. pallet(3) = &HFFFFD700: pallet(4) = &HFFC0C0C0: pallet(5) = &HFFFF0000
7. pallet(6) = &HFFFFFFFF: pallet(7) = &HFF0000FF
8. FOR x = xmax TO 0 STEP -200
9.     offset = toggle * 200
10.     FOR y = 0 TO ymax + 200 STEP 400
11.         ring x, y + offset, 200, 195
12.         side = 193
13.         FOR n = 3 TO 7
14.             pAngle = 2 * PI / n
15.             FOR i = 0 TO n + 1
16.                 x0 = x + side * COS(i * pAngle + PI / 2)
17.                 y0 = y + offset + side * SIN(i * pAngle + PI / 2)
18.                 IF i > 1 THEN
19.                     drawLink lastx, lasty, 2.5, x0, y0, 2.5, pallet(n)
20.                     midx = (x0 + lastx) / 2: midy = (y0 + lasty) / 2
21.                 END IF
22.                 lastx = x0: lasty = y0
23.             NEXT
24.             r = ((midx - x) ^ 2 + (midy - (y + offset)) ^ 2) ^ .5 - 3.5
25.             IF n < 7 THEN ring x, y + offset, r, r - 5
26.             side = r - 9
27.         NEXT
28.     NEXT
29.     toggle = (toggle + 1) MOD 2
30. NEXT
31. SLEEP
32.  
33. SUB ring (x, y, outerR, innerR)
34.     DIM pm2, pd3, pd6, a, x1, y1, x2, y2, c AS _UNSIGNED LONG
35.     pm2 = PI * 2: pd3 = PI / 3: pd6 = pd3 / 2 'pd6 aligns red at bottom cyan at top, nice Steve!
36.     FOR a = 0 TO pm2 STEP .00001 ' <<<<<<<<<<<< increased, still finding holes
37.         x1 = x + outerR * COS(a - pd6): y1 = y + outerR * SIN(a - pd6)
38.         x2 = x + innerR * COS(a - pd6): y2 = y + innerR * SIN(a - pd6)
39.         IF a < pd3 THEN
40.             c = _RGB32(255 * a / pd3, 255, 0)
41.         ELSEIF a < 2 * pd3 THEN
42.             c = _RGB32(255, 255 - 255 * (a - pd3) / pd3, 0)
43.         ELSEIF a < 3 * pd3 THEN
44.             c = _RGB32(255, 0, 255 * (a - 2 * pd3) / pd3)
45.         ELSEIF a < 4 * pd3 THEN
46.             c = _RGB32(255 - 255 * (a - 3 * pd3) / pd3, 0, 255)
47.         ELSEIF a < 5 * pd3 THEN
48.             c = _RGB32(0, 255 * (a - 4 * pd3) / pd3, 255)
49.         ELSE
50.             c = _RGB32(0, 255, 255 - 255 * (a - 5 * pd3) / pd3)
51.         END IF
52.         LINE (x1, y1)-(x2, y2), c
53.     NEXT
54. END SUB
55.  
56. SUB drawLink (x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
57.     DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
58.     a = _ATAN2(y2 - y1, x2 - x1)
59.     a1 = a + _PI(1 / 2): a2 = a - _PI(1 / 2)
60.     x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
61.     x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
62.     x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
63.     x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
64.     ftri x3, y3, x4, y4, x6, y6, c
65.     ftri x5, y5, x6, y6, x3, y3, c
66.     fcirc x1, y1, r1, c: fcirc x2, y2, r2, c
67. END SUB
68.  
69. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
70.     DIM a&
71.     a& = _NEWIMAGE(1, 1, 32)
72.     _DEST a&
73.     PSET (0, 0), K
74.     _DEST 0
75.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
76.     _FREEIMAGE a& '<<< this is important!
77. END SUB
78.  
79. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
80.     DIM Radius AS INTEGER, RadiusError AS INTEGER
81.     DIM X AS INTEGER, Y AS INTEGER
82.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
83.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
84.     LINE (CX - X, CY)-(CX + X, CY), C, BF
85.     WHILE X > Y
86.         RadiusError = RadiusError + Y * 2 + 1
87.         IF RadiusError >= 0 THEN
88.             IF X <> Y + 1 THEN
89.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
90.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
91.             END IF
92.             X = X - 1
93.             RadiusError = RadiusError - X * 2
94.         END IF
95.         Y = Y + 1
96.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
97.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
98.     WEND
99. END SUB
100.