Text Only | Text with Attachments

QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: SMcNeill on July 06, 2019, 09:48:35 pm

Title: One more pattern challenge
Post by: SMcNeill on July 06, 2019, 09:48:35 pm
Here's a nice strange little pattern I created while playing around a bit earlier.  I thought I'd share it and see how long it'd take bplus (or anyone else) to reproduce it.

Trickiest part (for me, at least), was sorting out how to color the circles all pretty, as they are.  :P

Title: Re: One more pattern challenge
Post by: bplus on July 06, 2019, 10:22:53 pm
Yes! Very nice coloring on circles, but what's happening with some of the large triangles?

OK, I'll start thinking about those circles :D



Title: Re: One more pattern challenge
Post by: SMcNeill on July 06, 2019, 10:28:32 pm
To be honest, I have no idea what the heck is up with the left triangle side.  It’s  created via a series of lines and then paint filled.  As far as I can tell, there’s absolutely no reason for them to leave those black streaks in them. 
Title: Re: One more pattern challenge
Post by: Pete on July 06, 2019, 10:53:17 pm
I tried out some code, but the pattern was too tight for my 15" monitor; so I hooked up my 27" 1950's TV/Monitor. Maybe I'm just missing a few circle statements, but this is the closet I could come to Steve's image...

  [ This attachment cannot be displayed inline in 'Print Page' view ]  

Pete
Title: Re: One more pattern challenge
Post by: Ashish on July 07, 2019, 12:02:25 pm
Challenge accepted Steve! :D
I did this in about 3-4 hrs.
Code: QB64: [Select]
  1. _TITLE "Pattern Challenge For Steve"
  2. SCREEN _NEWIMAGE(700, 700, 32)
  4.     _LIMIT 40
  6. SUB _GL ()
  7.     _glLineWidth 6.0
  8.     FOR y = 1 TO -1 STEP -0.5
  9.         IF k = 0 THEN
  10.             f = 0
  11.             k = 1
  12.         ELSE
  13.             k = 0
  14.             f = 0.5
  15.         END IF
  16.         FOR x = -1 + f TO 1 + f STEP 1
  17.             pattern x, y, 0.5, 3
  18.         NEXT
  19.     NEXT
  20.     _glRotatef -30, 0, 1, 0
  22. SUB pattern (x, y, r, N)
  23.     IF N > 7 THEN EXIT SUB
  24.     gl_npoly x, y, r, 300
  25.     gl_npoly x, y, r, N
  26.     __x = ((x + r) + (x + r * COS(_PI(2) / N))) * 0.5
  27.     __y = (y + (y + r * SIN(_PI(2) / N))) * 0.5
  28.     nr = SQR((__x - x) ^ 2 + (__y - y) ^ 2)
  29.     pattern x, y, nr - (1 / 50), N + 1 'nr - (1/(d*(2/width)))
  31. SUB gl_npoly (x, y, r, NOV)
  32.     IF NOV MOD 2 = 1 THEN d = 1 / (2 * NOV)
  33.     IF NOV = 3 THEN _glColor3f 1, 1, 0
  34.     IF NOV = 4 THEN _glColor3f 0.5, 0.5, 0.5
  35.     IF NOV = 5 THEN _glColor3f 1, 0, 0
  36.     IF NOV = 6 THEN _glColor3f 1, 1, 1
  37.     IF NOV = 7 THEN _glColor3f 0, 0, 1
  38.     _glBegin _GL_LINE_LOOP
  39.     FOR i = _PI(d) TO _PI(2 + d) STEP _PI(2) / NOV
  40.         IF NOV > 7 THEN
  41.             c~& = hsb(ABS(_R2D(i)), 1, 0.6, 255)
  42.             _glColor3f _RED(c~&) / 255, _GREEN(c~&) / 255, _BLUE(c~&) / 255
  43.         END IF
  44.         _glVertex2f x + r * COS(i), y + r * SIN(i)
  45.     NEXT
  46.     _glEnd
  48. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  49.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  50.  
  51.     H = __H 'map(__H, 0, 255, 0, 360)
  52.     S = __S 'map(__S, 0, 255, 0, 1)
  53.     B = __B ' map(__B, 0, 255, 0, 1)
  54.  
  55.     IF S = 0 THEN
  56.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  57.         EXIT FUNCTION
  58.     END IF
  59.  
  60.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  61.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  62.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  63.  
  64.     IF B > .5 THEN
  65.         fmx = B - (B * S) + S
  66.         fmn = B + (B * S) - S
  67.     ELSE
  68.         fmx = B + (B * S)
  69.         fmn = B - (B * S)
  70.     END IF
  71.  
  72.     iSextant = INT(H / 60)
  73.  
  74.     IF H >= 300 THEN
  75.         H = H - 360
  76.     END IF
  77.  
  78.     H = H / 60
  79.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  80.  
  81.     IF iSextant MOD 2 = 0 THEN
  82.         fmd = (H * (fmx - fmn)) + fmn
  83.     ELSE
  84.         fmd = fmn - (H * (fmx - fmn))
  85.     END IF
  86.  
  87.     imx = _ROUND(fmx * 255)
  88.     imd = _ROUND(fmd * 255)
  89.     imn = _ROUND(fmn * 255)
  90.  
  91.     SELECT CASE INT(iSextant)
  92.         CASE 1
  93.             hsb~& = _RGBA32(imd, imx, imn, A)
  94.         CASE 2
  95.             hsb~& = _RGBA32(imn, imx, imd, A)
  96.         CASE 3
  97.             hsb~& = _RGBA32(imn, imd, imx, A)
  98.         CASE 4
  99.             hsb~& = _RGBA32(imd, imn, imx, A)
  100.         CASE 5
  101.             hsb~& = _RGBA32(imx, imn, imd, A)
  102.         CASE ELSE
  103.             hsb~& = _RGBA32(imx, imd, imn, A)
  104.     END SELECT
  105.  
  107.  
Title: Re: One more pattern challenge
Post by: Pete on July 07, 2019, 12:22:26 pm
FAIL! The colors are wrong and patterns are missing inside the red pentagons.

OK, I'm just busting your balloons. You did remarkably well in just 100 lines of code to approximate the pattern and reproduce some of the colors correctly. It probably only took you an hour, to boot. (I'm on Windows 10, and an hour to boot is a good day!)

Pete

 
Title: Re: One more pattern challenge
Post by: Ashish on July 07, 2019, 12:43:55 pm
Ok. I fixed the color. It is not missing the pattern. The shapes are just overlapping each other..... and I think it must be within the rule of this
challenge.
Code: QB64: [Select]
  1. _TITLE "Pattern Challenge For Steve"
  2. SCREEN _NEWIMAGE(600, 600, 32)
  4. w = 0.02
  6.     _LIMIT 40
  8. SUB _GL ()
  9.     _glLineWidth (_WIDTH / 2) * w
  10.     _glRotatef -90, 0, 0, 1
  11.     FOR y = 1 TO -1 STEP -0.5
  12.         IF k = 0 THEN
  13.             f = 0
  14.             k = 1
  15.         ELSE
  16.             k = 0
  17.             f = 0.5
  18.         END IF
  19.         FOR x = -1 + f TO 1 + f STEP 1
  20.             pattern x, y, 0.5, 3
  21.         NEXT
  22.     NEXT
  23.  
  25. SUB pattern (x, y, r, N)
  26.     IF N > 7 THEN EXIT SUB
  27.     gl_npoly x, y, r, 300
  28.     gl_npoly x, y, r, N
  29.     __x = ((x + r) + (x + r * COS(_PI(2) / N))) * 0.5
  30.     __y = (y + (y + r * SIN(_PI(2) / N))) * 0.5
  31.     nr = SQR((__x - x) ^ 2 + (__y - y) ^ 2)
  32.     pattern x, y, nr - w, N + 1 'nr - (1/(d*(2/width)))
  34. SUB gl_npoly (x, y, r, NOV)
  35.     IF NOV MOD 2 = 1 THEN d = 2 / 3
  36.     IF NOV = 3 THEN _glColor3f 1, 1, 0
  37.     IF NOV = 4 THEN _glColor3f 0.5, 0.5, 0.5
  38.     IF NOV = 5 THEN _glColor3f 1, 0, 0
  39.     IF NOV = 6 THEN _glColor3f 1, 1, 1
  40.     IF NOV = 7 THEN _glColor3f 0, 0, 1
  41.     _glBegin _GL_LINE_LOOP
  42.     FOR i = _PI(d) TO _PI(2 + d) STEP _PI(2) / NOV
  43.         IF NOV > 7 THEN
  44.             c~& = hsb(ABS(_R2D(i)), 1, 0.6, 255)
  45.             _glColor3f _RED(c~&) / 255, _GREEN(c~&) / 255, _BLUE(c~&) / 255
  46.         END IF
  47.         _glVertex2f x + r * COS(i), y + r * SIN(i)
  48.     NEXT
  49.     _glEnd
  51. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  52.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  53.  
  54.     H = __H 'map(__H, 0, 255, 0, 360)
  55.     S = __S 'map(__S, 0, 255, 0, 1)
  56.     B = __B ' map(__B, 0, 255, 0, 1)
  57.  
  58.     IF S = 0 THEN
  59.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  60.         EXIT FUNCTION
  61.     END IF
  62.  
  63.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  64.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  65.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  66.  
  67.     IF B > .5 THEN
  68.         fmx = B - (B * S) + S
  69.         fmn = B + (B * S) - S
  70.     ELSE
  71.         fmx = B + (B * S)
  72.         fmn = B - (B * S)
  73.     END IF
  74.  
  75.     iSextant = INT(H / 60)
  76.  
  77.     IF H >= 300 THEN
  78.         H = H - 360
  79.     END IF
  80.  
  81.     H = H / 60
  82.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  83.  
  84.     IF iSextant MOD 2 = 0 THEN
  85.         fmd = (H * (fmx - fmn)) + fmn
  86.     ELSE
  87.         fmd = fmn - (H * (fmx - fmn))
  88.     END IF
  89.  
  90.     imx = _ROUND(fmx * 255)
  91.     imd = _ROUND(fmd * 255)
  92.     imn = _ROUND(fmn * 255)
  93.  
  94.     SELECT CASE INT(iSextant)
  95.         CASE 1
  96.             hsb~& = _RGBA32(imd, imx, imn, A)
  97.         CASE 2
  98.             hsb~& = _RGBA32(imn, imx, imd, A)
  99.         CASE 3
  100.             hsb~& = _RGBA32(imn, imd, imx, A)
  101.         CASE 4
  102.             hsb~& = _RGBA32(imd, imn, imx, A)
  103.         CASE 5
  104.             hsb~& = _RGBA32(imx, imn, imd, A)
  105.         CASE ELSE
  106.             hsb~& = _RGBA32(imx, imd, imn, A)
  107.     END SELECT
  108.  
  110.  
Title: Re: One more pattern challenge
Post by: SMcNeill on July 07, 2019, 12:46:32 pm
Excellent use of _GL commands, Ashish!  To be honest, I'd considered making use of them myself, to color my main circle, but I didn't.  Instead, I used a much more "BASIC" method:

Code: QB64: [Select]
  2. DIM BlendedScreen AS LONG
  3.  
  4. ViewScreen = _NEWIMAGE(800, 800, 32): SCREEN ViewScreen
  5.  
  6.  
  7. CreateBlendedScreen 'Create a blended screen of colors
  8. SCREEN BlendedScreen 'Display that  screen
  9. SLEEP 'Pause so folks can view that screen
  10.  
  11. 'For fun, add some fontage to the screen also
  12. COLOR &HFF000000, 0 'Black with transparent background
  13. f = _LOADFONT("cour.ttf", 48)
  14. IF f > 0 THEN
  15.     _FONT f
  16.     w = _PRINTWIDTH("Hello World! We love STEVE! He's Sooo AWESOME!")
  17.     sw = _WIDTH: sh = _HEIGHT
  18.     _PRINTSTRING ((sw - w) \ 2 + 1, 0), "Hello World! We love STEVE! He's Sooo AWESOME!"
  20.  
  21. SLEEP 'Give the user the time to see our nice screen pattern which we're going to "warp" to our circle.
  22.  
  23.  
  24. SCREEN ViewScreen 'Swap back over to our main screen
  25. CreateCircle 400, 400, 400, 100 'Use that blended screen as reference so we can plot/color our circle in that same pattern
  26. SLEEP 'Pause to show the circle before ending the demo
  28.  
  29.  
  30. SUB CreateCircle (Xcenter, YCenter, radius AS LONG, width AS LONG)
  31.     SHARED BlendedScreen AS LONG
  32.     p = _PI(2) * radius
  33.     tempimage = _NEWIMAGE(p, width, 32)
  34.     _PUTIMAGE , BlendedScreen, tempimage
  35.     _SOURCE tempimage
  36.     FOR i = 0 TO p - 1 STEP .25
  37.         FOR w = 0 TO width - 1
  38.             ai = 360 / p
  39.             a = _D2R(ai * i)
  40.             x = Xcenter - SIN(a) * (radius - w)
  41.             y = YCenter + COS(a) * (radius - w)
  42.             PSET (x, y), POINT(i, w)
  43.         NEXT
  44.     NEXT
  45.     _SOURCE 0
  46.     _FREEIMAGE tempimage
  48.  
  49.  
  50. SUB CreateBlendedScreen
  51.     SHARED BlendedScreen AS LONG
  52.     IF NOT BlendedScreen THEN BlendedScreen = _NEWIMAGE(1536, 50, 32) ELSE EXIT SUB
  53.     'step from red to green
  54.     DIM kolor AS _FLOAT, i AS _FLOAT
  55.     _DEST BlendedScreen
  56.     FOR i = 0 TO 255
  57.         kolor = kolor + 1
  58.         LINE (i, 0)-STEP(0, 99), _RGB32(255, kolor, 0)
  59.     NEXT
  60.     FOR i = 256 TO 511
  61.         kolor = kolor - 1
  62.         LINE (i, 0)-STEP(0, 99), _RGB32(kolor, 255, 0)
  63.     NEXT
  64.     FOR i = 512 TO 767
  65.         kolor = kolor + 1
  66.         LINE (i, 0)-STEP(0, 99), _RGB32(0, 255, kolor)
  67.     NEXT
  68.     FOR i = 768 TO 1023
  69.         kolor = kolor - 1
  70.         LINE (i, 0)-STEP(0, 99), _RGB32(0, kolor, 255)
  71.     NEXT
  72.     FOR i = 1024 TO 1279
  73.         kolor = kolor + 1
  74.         LINE (i, 0)-STEP(0, 99), _RGB32(kolor, 0, 255)
  75.     NEXT
  76.     FOR i = 1280 TO 1535
  77.         kolor = kolor - 1
  78.         LINE (i, 0)-STEP(0, 99), _RGB32(255, 0, kolor)
  79.     NEXT
  80.     _DEST ViewScreen
  82.  

The magic all takes place inside the CreateCircle sub, where it basically reads the flat square screen, and then warps its contents and plots them onto a circular surface for us.

As you can see from the little demo above, it doesn't actually blend colors; it maps square points to a circular pattern, which allows us to bend text to fit the circle and look natural.

(If you don't have the "courier new, regular" font on your system, kindly change the line which loads it so that it'll point to a font of your choosing so the demo can display properly and in all its glory.)
Title: Re: One more pattern challenge
Post by: SMcNeill on July 07, 2019, 01:10:05 pm
Quote from: Ashish on July 07, 2019, 12:43:55 pm
Ok. I fixed the color. It is not missing the pattern. The shapes are just overlapping each other..... and I think it must be within the rule of this
challenge.

Only thing I really noticed that seemed off is just a little math.  Your polygons are from the outer ring of your circle and not the inner ring.  ;)


Now, for some honesty on my part:  The screenshot produced wasn't the actual results which I was looking for -- it's a glitched pattern which I thought was kinda cute and decided to share.

The glitchy code to produce our perfectly imperfect pattern is this one:
Code: QB64: [Select]
  2.  
  3. DIM SHARED ViewScreen, BlendedScreen
  4. CONST Gold = &HFFFFD700~& ' _RGB32(255,215,0)
  5. CONST Silver = &HFFC0C0C0~& ' _RGB32(192,192,192)
  6.  
  7. ViewScreen = _NEWIMAGE(800, 800, 32): SCREEN ViewScreen
  8. BlendedScreen = _NEWIMAGE(1536, 100, 32)
  9. CircleScreen = _NEWIMAGE(400, 400, 32) '200 radius outer circle
  10.  
  11. CreateBlendedScreen
  12.  
  13. width = 6
  15. k(3) = Gold
  16. k(4) = Silver
  17. k(5) = &HFFFF0000 'Red
  18. k(6) = &HFFFFFFFF 'White
  19. k(7) = &HFF0000FF 'Blue
  20.  
  21. FOR x = 200 TO 600 STEP 400
  22.     FOR y = 200 TO 600 STEP 400
  23.         length = 200
  24.         FOR i = 3 TO 7
  25.             DrawPattern x, y, length, width, i, k(i)
  26.             length = (length - 2 * width) * COS(_PI / i) - 1
  27.         NEXT
  28.     NEXT
  30.  
  33.  
  34. SUB DrawPattern (Xcenter, Ycenter, Radius, Width, N, Kolor AS _UNSIGNED LONG)
  35.     CreateCircleScreen Xcenter, Ycenter, Radius, Width
  36.     DisplayImage ViewScreen, Xcenter, Ycenter, 0, 0
  37.     CreatePolygon Xcenter, Ycenter, Radius - Width, Width, N, Kolor
  39.  
  40. SUB CreatePolygon (Xcenter, YCenter, Radius AS LONG, width AS LONG, N AS LONG, Kolor AS _UNSIGNED LONG)
  41.     a = _PI(2) / N
  42.     FOR i = 0 TO 1
  43.         x = 0
  44.         IF i THEN Radius = Radius - width
  45.         FOR p = 0 TO _PI(2) STEP a
  46.             IF x THEN oldx = x: oldy = y
  47.             x = Xcenter + SIN(p) * Radius
  48.             y = YCenter + COS(p) * Radius
  49.             IF oldx THEN LINE (oldx, oldy)-(x, y), Kolor
  50.         NEXT
  51.         x2 = Xcenter + SIN(p) * Radius
  52.         y2 = YCenter + COS(p) * Radius
  53.         LINE (x, y)-(x2, y2), Kolor
  54.     NEXT
  55.     x = Xcenter + SIN(p) * (Radius + width / 2)
  56.     y = YCenter + COS(p) * (Radius + width / 2)
  57.     PAINT (x, y), Kolor
  59.  
  60. SUB CreateCircleScreen (Xcenter, YCenter, radius AS LONG, width AS LONG)
  61.     'CreateCircleScreen = _NEWIMAGE(radius * 2, radius * 2, 32)
  62.     '_DEST CreateCircleScreen
  63.     p = _PI(2) * radius
  64.     tempimage = _NEWIMAGE(p, width, 32)
  65.     _PUTIMAGE , BlendedScreen, tempimage
  66.     _SOURCE tempimage
  67.     FOR i = 0 TO p - 1 STEP .25
  68.         FOR w = 0 TO width - 1
  69.             ai = 360 / p
  70.             a = _D2R(ai * i)
  71.             x = Xcenter + SIN(a) * (radius - w)
  72.             y = YCenter + COS(a) * (radius - w)
  73.             PSET (x, y), POINT(i, w)
  74.         NEXT
  75.     NEXT
  76.     _SOURCE ViewScreen
  77.     ' _DEST ViewScreen
  78.     _FREEIMAGE tempimage
  80.  
  81.  
  82. SUB CreateBlendedScreen
  83.     'step from red to green
  84.     DIM kolor AS _FLOAT, i AS _FLOAT
  85.     _DEST BlendedScreen
  86.     FOR i = 0 TO 255
  87.         kolor = kolor + 1
  88.         LINE (i, 0)-STEP(0, 99), _RGB32(255, kolor, 0)
  89.     NEXT
  90.     FOR i = 256 TO 511
  91.         kolor = kolor - 1
  92.         LINE (i, 0)-STEP(0, 99), _RGB32(kolor, 255, 0)
  93.     NEXT
  94.     FOR i = 512 TO 767
  95.         kolor = kolor + 1
  96.         LINE (i, 0)-STEP(0, 99), _RGB32(0, 255, kolor)
  97.     NEXT
  98.     FOR i = 768 TO 1023
  99.         kolor = kolor - 1
  100.         LINE (i, 0)-STEP(0, 99), _RGB32(0, kolor, 255)
  101.     NEXT
  102.     FOR i = 1024 TO 1279
  103.         kolor = kolor + 1
  104.         LINE (i, 0)-STEP(0, 99), _RGB32(kolor, 0, 255)
  105.     NEXT
  106.     FOR i = 1280 TO 1535
  107.         kolor = kolor - 1
  108.         LINE (i, 0)-STEP(0, 99), _RGB32(255, 0, kolor)
  109.     NEXT
  110.     _DEST ViewScreen
  112.  
  113.  
  114. SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, angle AS SINGLE, mode AS _BYTE)
  115.     'Image is the image handle which we use to reference our image.
  116.     'x,y is the X/Y coordinates where we want the image to be at on the screen.
  117.     'angle is the angle which we wish to rotate the image.
  118.     'mode determines HOW we place the image at point X,Y.
  119.     'Mode 0 we center the image at point X,Y
  120.     'Mode 1 we place the Top Left corner of oour image at point X,Y
  121.     'Mode 2 is Bottom Left
  122.     'Mode 3 is Top Right
  123.     'Mode 4 is Bottom Right
  124.  
  125.  
  126.     DIM px(3) AS INTEGER, py(3) AS INTEGER, w AS INTEGER, h AS INTEGER
  127.     DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
  128.     w = _WIDTH(Image): h = _HEIGHT(Image)
  129.     SELECT CASE mode
  130.         CASE 0 'center
  131.             px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
  132.             px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
  133.         CASE 1 'top left
  134.             px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
  135.             px(1) = 0: py(1) = h: px(2) = w: py(2) = h
  136.         CASE 2 'bottom left
  137.             px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
  138.             px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
  139.         CASE 3 'top right
  140.             px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
  141.             px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
  142.         CASE 4 'bottom right
  143.             px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
  144.             px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
  145.     END SELECT
  146.     sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
  147.     FOR i = 0 TO 3
  148.         x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
  149.         px(i) = x2: py(i) = y2
  150.     NEXT
  151.     _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  152.     _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

The actual pattern I was looking for is this one (which requires only a single line remarked out):
Code: [Select]
_DEFINE A-Z AS _FLOAT

DIM SHARED ViewScreen, BlendedScreen
CONST Gold = &HFFFFD700~& ' _RGB32(255,215,0)
CONST Silver = &HFFC0C0C0~& ' _RGB32(192,192,192)

ViewScreen = _NEWIMAGE(800, 800, 32): SCREEN ViewScreen
BlendedScreen = _NEWIMAGE(1536, 100, 32)
CircleScreen = _NEWIMAGE(400, 400, 32) '200 radius outer circle

CreateBlendedScreen

width = 6
DIM k(3 TO 7) AS _UNSIGNED LONG
k(3) = Gold
k(4) = Silver
k(5) = &HFFFF0000 'Red
k(6) = &HFFFFFFFF 'White
k(7) = &HFF0000FF 'Blue

FOR x = 200 TO 600 STEP 400
    FOR y = 200 TO 600 STEP 400
        length = 200
        FOR i = 3 TO 7
            DrawPattern x, y, length, width, i, k(i)
            length = (length - 2 * width) * COS(_PI / i) - 1
        NEXT
    NEXT
NEXT

SLEEP
END

SUB DrawPattern (Xcenter, Ycenter, Radius, Width, N, Kolor AS _UNSIGNED LONG)
    CreateCircleScreen Xcenter, Ycenter, Radius, Width
    'DisplayImage ViewScreen, Xcenter, Ycenter, 0, 0
    CreatePolygon Xcenter, Ycenter, Radius - Width, Width, N, Kolor
END SUB

SUB CreatePolygon (Xcenter, YCenter, Radius AS LONG, width AS LONG, N AS LONG, Kolor AS _UNSIGNED LONG)
    a = _PI(2) / N
    FOR i = 0 TO 1
        x = 0
        IF i THEN Radius = Radius - width
        FOR p = 0 TO _PI(2) STEP a
            IF x THEN oldx = x: oldy = y
            x = Xcenter + SIN(p) * Radius
            y = YCenter + COS(p) * Radius
            IF oldx THEN LINE (oldx, oldy)-(x, y), Kolor
        NEXT
        x2 = Xcenter + SIN(p) * Radius
        y2 = YCenter + COS(p) * Radius
        LINE (x, y)-(x2, y2), Kolor
    NEXT
    x = Xcenter + SIN(p) * (Radius + width / 2)
    y = YCenter + COS(p) * (Radius + width / 2)
    PAINT (x, y), Kolor
END SUB

SUB CreateCircleScreen (Xcenter, YCenter, radius AS LONG, width AS LONG)
    'CreateCircleScreen = _NEWIMAGE(radius * 2, radius * 2, 32)
    '_DEST CreateCircleScreen
    p = _PI(2) * radius
    tempimage = _NEWIMAGE(p, width, 32)
    _PUTIMAGE , BlendedScreen, tempimage
    _SOURCE tempimage
    FOR i = 0 TO p - 1 STEP .25
        FOR w = 0 TO width - 1
            ai = 360 / p
            a = _D2R(ai * i)
            x = Xcenter + SIN(a) * (radius - w)
            y = YCenter + COS(a) * (radius - w)
            PSET (x, y), POINT(i, w)
        NEXT
    NEXT
    _SOURCE ViewScreen
    ' _DEST ViewScreen
    _FREEIMAGE tempimage
END SUB


SUB CreateBlendedScreen
    'step from red to green
    DIM kolor AS _FLOAT, i AS _FLOAT
    _DEST BlendedScreen
    FOR i = 0 TO 255
        kolor = kolor + 1
        LINE (i, 0)-STEP(0, 99), _RGB32(255, kolor, 0)
    NEXT
    FOR i = 256 TO 511
        kolor = kolor - 1
        LINE (i, 0)-STEP(0, 99), _RGB32(kolor, 255, 0)
    NEXT
    FOR i = 512 TO 767
        kolor = kolor + 1
        LINE (i, 0)-STEP(0, 99), _RGB32(0, 255, kolor)
    NEXT
    FOR i = 768 TO 1023
        kolor = kolor - 1
        LINE (i, 0)-STEP(0, 99), _RGB32(0, kolor, 255)
    NEXT
    FOR i = 1024 TO 1279
        kolor = kolor + 1
        LINE (i, 0)-STEP(0, 99), _RGB32(kolor, 0, 255)
    NEXT
    FOR i = 1280 TO 1535
        kolor = kolor - 1
        LINE (i, 0)-STEP(0, 99), _RGB32(255, 0, kolor)
    NEXT
    _DEST ViewScreen
END SUB


SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, angle AS SINGLE, mode AS _BYTE)
    'Image is the image handle which we use to reference our image.
    'x,y is the X/Y coordinates where we want the image to be at on the screen.
    'angle is the angle which we wish to rotate the image.
    'mode determines HOW we place the image at point X,Y.
    'Mode 0 we center the image at point X,Y
    'Mode 1 we place the Top Left corner of oour image at point X,Y
    'Mode 2 is Bottom Left
    'Mode 3 is Top Right
    'Mode 4 is Bottom Right


    DIM px(3) AS INTEGER, py(3) AS INTEGER, w AS INTEGER, h AS INTEGER
    DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE
    w = _WIDTH(Image): h = _HEIGHT(Image)
    SELECT CASE mode
        CASE 0 'center
            px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
            px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2
        CASE 1 'top left
            px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
            px(1) = 0: py(1) = h: px(2) = w: py(2) = h
        CASE 2 'bottom left
            px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
            px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0
        CASE 3 'top right
            px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
            px(1) = -w: py(1) = h: px(2) = 0: py(2) = h
        CASE 4 'bottom right
            px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
            px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0
    END SELECT
    sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)
    FOR i = 0 TO 3
        x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
        px(i) = x2: py(i) = y2
    NEXT
    _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
Line 36 is remarked out, as I changed my methodology in the midst of my coding.  At first, I was going to take blended lines as well, rotate them and place them at their midpoints so they'd fit in the proper slots, but then I decided not to worry with it.  I would've had to map segments of the overall blended colors to each side, to run the blended pattern across the whole polygon, and I just didn't think it was worth the hassle.  All I needed was a nice little pattern set so I could print out some colorful CD/DVD labels, and to be honest, I was just too lazy to go through the effort to blend the  lines as well.  :P

In the steps of removing the polygon line blending (and use of DisplayImage for rotational ease at the center point), I tested what I *thought* should produce my desired pattern -- only to blink stupidly and say, "What the Taco Bell????????"...

... And thus, I shared the glitch, just 'cause I found it rather amusing.  ;D
Title: Re: One more pattern challenge
Post by: Ashish on July 07, 2019, 01:11:30 pm
Steve,
Cool to know you were using this method for circle. I think you already posted a similar demo for printing text in this way somewhere before....
Title: Re: One more pattern challenge
Post by: SMcNeill on July 07, 2019, 01:16:39 pm
Quote from: Ashish on July 07, 2019, 01:11:30 pm
Steve,
Cool to know you were using this method for circle. I think you already posted a similar demo for printing text in this way somewhere before....

Aye, a CircleText demo routine, which I've shared before. You've got a good memory.  ;)

Here's another trick which I like to do, using this method:  Slowly reduce the radius as you plot the square around onto your circle.  Doing so, you can make a spiral, and if you animate it by scrolling the text across the square source page, you can make it seem as if you're flushing the text down a toilet... 
Title: Re: One more pattern challenge
Post by: Ashish on July 07, 2019, 01:16:54 pm
Quote from: SMcNeill on July 07, 2019, 01:10:05 pm
Only thing I really noticed that seemed off is just a little math.  Your polygons are from the outer ring of your circle and not the inner ring.  ;)
I am already subtracting radius with line width but it is not working as expected. See on line 32 of my second code.
Title: Re: One more pattern challenge
Post by: SMcNeill on July 07, 2019, 01:29:23 pm
Quote from: Ashish on July 07, 2019, 01:16:54 pm
I am already subtracting radius with line width but it is not working as expected. See on line 32 of my second code.

In sub pattern, subtract the width of the circle before drawing the polygon.

Code: QB64: [Select]
  1. SUB pattern (x, y, r, N)
  2.     IF N > 7 THEN EXIT SUB
  3.     gl_npoly x, y, r, 300
  4.     r = r - w 'Add this little line into the code so the polygon draws to the inner edge of the circle and not the outer.  
  5.     gl_npoly x, y, r, N
  6.     __x = ((x + r) + (x + r * COS(_PI(2) / N))) * 0.5
  7.     __y = (y + (y + r * SIN(_PI(2) / N))) * 0.5
  8.     nr = SQR((__x - x) ^ 2 + (__y - y) ^ 2)
  9.     pattern x, y, nr - w, N + 1 'nr - (1/(d*(2/width)))
Title: Re: One more pattern challenge
Post by: Pete on July 07, 2019, 02:06:39 pm
Oh, it's a sub pattern! Apparently I failed the challenge, because I was using a test pattern!

Well the code is interesting to look at, but I tend to not get involved in these types of challenges, because I just can't think of a practical use for it in the type of apps I'm interested in.

Pete
Title: Re: One more pattern challenge
Post by: bplus on July 07, 2019, 04:21:21 pm
I scaled and overlapped different, took too long to get those color rings going (completely different method) and match the color of triangles. What do you call that Steve? :D

Edit: oops missing stuff on right side, fixed.
Title: Re: One more pattern challenge
Post by: Pete on July 07, 2019, 05:04:14 pm
Getting closer. In Steve's, the upper left big circle overlaps the 2nd circle inside the middle circle. Mark, your pattern underlaps it. Sorry, I had to make up a new word to describe the observation.

Really close, though, especially the colors.

Pete
Title: Re: One more pattern challenge
Post by: SMcNeill on July 07, 2019, 05:35:28 pm
Quote from: bplus on July 07, 2019, 04:21:21 pm
I scaled and overlapped different, took too long to get those color rings going (completely different method) and match the color of triangles. What do you call that Steve? :D

Edit: oops missing stuff on right side, fixed.

When I first came up with the idea, back in the day, I simply called it a CircleText routine, as its purpose was to warp text around a circle for me.  Since then, I’ve used the concept a zillion different ways, to generate a zillion different uses, yet I don’t think I’ve seen anyone else make use of it.  I suppose a technical way to think of it is to just call it a “Pixel Point Plotting Method”.

If I told you to manually plot me a circle, how would you do it?  Probably a loop from 0 to _PI(2), which calculates the circle points using SIN and COS.


Now, think of using that process in reverse to “unroll” your circle onto a flat piece of paper.

The circumference of that circle is, of course, 2 * Pi * Radius, so we absolutely know how many pixels we need for it — the LENGTH of that ring, if we “unrolled” it onto a piece of paper.

And, if we define how thick we want the ring to be (Radius for the whole circle, less than that for just a ring — like a donut — from that circle.), we can use that to define the definitive HEIGHT of the size of “paper” we’d unroll that ring upon.

With a length of 2 * Pi * Radius, and a height of Radius, we can “unroll” a complete circular surface onto a flat piece of paper.  Just go around, pixel-by-pixel, read one point on each ring in a clockwise direction, and plot its value sequentially to the points in a straight line; then move inwards on the circle, and downwards on your lines.

A round circle can be mapped to a square piece of paper, rather easily, using this method.  (Similar to the concept of mapping the globe onto a piece of paper.)

Reverse the process, and you can take a square image, and warp it back onto a circle again, easily enough.


And, once you get used to the idea of “Pixel Point Plotting”, you can use it in a million different ways.  If you can plot a ring on a circle from a square image, why not plot a thick sine wave from that same image?  Curve it via an arc?  Ellipse?  If you can plot the points manually for *any* design, why can’t you use the concept to twist a flat image onto it? 

Since I mainly used it for text manipulation when I first dreamed up the concept, it was a CircleText routine (Which is what Ashish remembers me sharing in the past), but once someone gets used to the concept behind the routine, then they can imagine exactly how many various ways they could possibly use it.

(One of these days, I’m thinking of doing a music visualizer like Petr enjoys making, and using the concept to map song lyrics to the SIN/COS waves produced by the music.  I think it’d be a trip, if I ever find the time to get around to it.). ;)
Title: Re: One more pattern challenge
Post by: Pete on July 07, 2019, 05:40:19 pm
...But all the really good songs were made about West Virginia.

Pete
Title: Re: One more pattern challenge
Post by: Petr on July 07, 2019, 06:03:46 pm
Hi Steve.

My first visualisation program use none MEM or PSET function. It is done so. Axis X is time. Axis Y is LEFT or RIGHT _SNDRAW sound channel value read from WAV. This give me X and Y axis.
Because _SNDRAW is very, but really very extreme processor offensive, is used ON TIMER.Is not possible draw all sound frames. It is 44100 samples per one second. Is not possible draw 44100 frames per second. So is calculated average sound values and draw to screen ( 1/20 for 20 FPS, what is enought). For this in first programs i use MAPTRIANGLE (2D), because it si really very fast. But for better outputs is MAYBE better playing sound using _SNDPLAY file (if WAV return better stereo, because _SNDRAW plays stereo badly) and just use values from WAV for visualisation. None from developers did me none answer for my ask: Where can SNDRAW to read? (in C++). What really do SNDRAWOPEN? if you try playing two MONO sources one left and one right, mixed output to both channells is returned. That is bad. Here is none path how use internal QB64 MP3/OGG decompressors to get RAW audio data. Why?

For best output for visualisation use hardware or OpenGL images. I use it in my last video on my Youtube channel. If you use OpenGL, this alone can do (fast) color mixing.
Title: Re: One more pattern challenge
Post by: bplus on July 07, 2019, 10:51:53 pm
Quote from: Pete on July 07, 2019, 05:04:14 pm
Getting closer. In Steve's, the upper left big circle overlaps the 2nd circle inside the middle circle. Mark, your pattern underlaps it. Sorry, I had to make up a new word to describe the observation.

Really close, though, especially the colors.

Pete

Had me scratching my head the overlap/underlap difference??? Then dahhh! I see he had posted his code already and it turns out Steve does y's before x's, drawing up and down first before side to side.

The answer to my color question is Gold, he calls the triangle color Gold.
My colors:
pallet(3) = &HFFFFCC33: pallet(4) = &HFFE5A5CC: pallet(5) = &HFFFC0000
pallet(6) = &HFFFFFFFF: pallet(7) = &HFF0000F1

His:
CONST Gold = &HFFFFD700~& ' _RGB32(255,215,0)
CONST Silver = &HFFC0C0C0~& ' _RGB32(192,192,192)
k(5) = &HFFFF0000 'Red
k(6) = &HFFFFFFFF 'White
k(7) = &HFF0000FF 'Blue

Close? I only nailed white :D

The real question or subject of interest to me anyway was the code that produced our, what I call, Rainbow Rings.

Here is a study doing it my way, in a sub called ring using a line method and Steve's way going pixel by pixel across the different arc radii to cover the width of the ring.

The line method looks really bad and leaves allot of holes until you get the step really, really low .00005, so I thought there might be an advantage to Steve's method but no... (EDIT/UPDATE: no there was an advantage to pixel by pixel.)

Test code:
Code: QB64: [Select]
  2. _TITLE "Rainbow Ring" 'bplus 2019-07-07
  3. ' QB64 X 64 v 1.3
  4. CONST xmax = 1220, ymax = 760, PI = 3.141592653589793
  5. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. DIM SHARED graphicsCalls AS _INTEGER64
  9. DIM offset, start, test
  10.  
  11. start = TIMER
  12. FOR test = 1 TO 20
  13.     CLS
  14.     offset = offset + PI / 120
  15.  
  16.     'compare two subs  comment out one or the other next 2 lines
  17.     'rainbowRing xmax / 2, ymax / 2, 250, 50, offset
  18.     ring xmax / 2, ymax / 2, 250, 50, offset
  19.  
  20.  
  21.     _DISPLAY
  23. PRINT "The number of graphics calls was:"; graphicsCalls
  24. PRINT "Time:"; TIMER - start
  26.  
  27. SUB ring (x, y, outerR, innerR, offset)
  28.     DIM pm2, pd3, pd6, a, aStep, x1, y1, x2, y2, c AS _UNSIGNED LONG
  29.     pm2 = PI * 2
  30.     pd3 = PI / 3
  31.     pd6 = pd3 / 2 'pd6 aligns red at 90 degrees bottom of circle and light almost white cyan at top, looks good Steve!
  32.  
  33.     'aStep = 1 / (20.1 * pm2 * outerR) 'this is what I used for screen shot
  34.     FOR a = 0 TO pm2 STEP .00005 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<  is this the flaw to this method????
  35.         x1 = x + outerR * COS(a - pd6 + offset)
  36.         y1 = y + outerR * SIN(a - pd6 + offset)
  37.         x2 = x + innerR * COS(a - pd6 + offset)
  38.         y2 = y + innerR * SIN(a - pd6 + offset)
  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.         graphicsCalls = graphicsCalls + 1
  54.     NEXT
  56.  
  57. SUB rainbowRing (x, y, outerR, innerR, offset) 'no lines, do arc/circle style
  58.     DIM pm2, pd3, pd6, r, a, aStep, x1, y1, x2, y2, c AS _UNSIGNED LONG
  59.     pm2 = PI * 2
  60.     pd3 = PI / 3
  61.     pd6 = pd3 / 2 'pd6 aligns red at 90 degrees bottom of circle and light almost white cyan at top, looks good Steve!
  62.  
  63.  
  64.     FOR r = innerR TO outerR 'step 1? seems to be OK
  65.  
  66.         'how many pixels 2*PI*R around the curve = how many steps needed to take around circle?
  67.         'aStep = 1 / (pm2 * outerR)  'nope not efficient
  68.         aStep = 1 / (pm2 * r) '<<<<  EDIT/UPDATE:  aha!!   this makes all the difference !!! (first tried outerR)
  69.  
  70.  
  71.         FOR a = 0 TO pm2 STEP aStep '>>>>>>>>>>> yeah seems to cover well and does not seem like allot
  72.             x1 = x + r * COS(a - pd6 + offset)
  73.             y1 = y + r * SIN(a - pd6 + offset)
  74.             IF a < pd3 THEN
  75.                 c = _RGB32(255 * a / pd3, 255, 0)
  76.             ELSEIF a < 2 * pd3 THEN
  77.                 c = _RGB32(255, 255 - 255 * (a - pd3) / pd3, 0)
  78.             ELSEIF a < 3 * pd3 THEN
  79.                 c = _RGB32(255, 0, 255 * (a - 2 * pd3) / pd3)
  80.             ELSEIF a < 4 * pd3 THEN
  81.                 c = _RGB32(255 - 255 * (a - 3 * pd3) / pd3, 0, 255)
  82.             ELSEIF a < 5 * pd3 THEN
  83.                 c = _RGB32(0, 255 * (a - 4 * pd3) / pd3, 255)
  84.             ELSE
  85.                 c = _RGB32(0, 255, 255 - 255 * (a - 5 * pd3) / pd3)
  86.             END IF
  87.             PSET (x1, y1), c
  88.             graphicsCalls = graphicsCalls + 1
  89.         NEXT
  90.     NEXT
  92.  

It seems the line method draws much less often and takes significantly less time.

EDIT ? UPDATE: Aha!! change one line and the results flipped, pixel method is now significantly better

aStep = 1 / (pm2 * r) '<<<<<<<<<<<<<  EDIT/UPDATE:  aha!!   this makes all the difference !!! (first tried outerR)
Title: Re: One more pattern challenge
Post by: Pete on July 07, 2019, 11:09:47 pm
14.45 seconds on my high speed Karnak The Magnificent laptop.

Pete
Title: Re: One more pattern challenge
Post by: SMcNeill on July 07, 2019, 11:16:18 pm
Step 0.00005 seems rather excessive to me.

Wouldn’t this work for the line method:

The outer points should only be a loop from 1 TO (2 * _PI * Radius) — one plot for each pixel in the circumference.

The corresponding inner points can be dealt with in that same loop (and should even have overlap, as the inner circle is going to be smaller as you move closer to the center).

So, shouldn’t the process be as simple as:

FOR I = 0 TO _PI(2) STEP 1 / Radius
   ‘Calculate, draw lines
NEXT

Or am I overlooking something?  Perhaps LINE and floating-point math generating gaps in spots I wouldn’t expect?

Testing will need to ensue...  Tomorrow!  ;)
Title: Re: One more pattern challenge
Post by: bplus on July 07, 2019, 11:24:54 pm
Hi Steve,

Line method leaves gaps near outer edge in odd places, math rounding or something, just enough to make the drawing imperfect. Maybe I am missing something...

Oh hey! Try outer Radius and then one or two layers down to catch the gaps with way less steps, maybe?
Title: Re: One more pattern challenge
Post by: Pete on July 07, 2019, 11:52:53 pm
Steve, you don't mean this: FOR a = 0 TO pm2 STEP 1 / (20.1 * pm2 * outerR) / 2

Because that's 3 times slower than what Mark posted with the .00005 STEP loop.

Pete
Title: Re: One more pattern challenge
Post by: SMcNeill on July 08, 2019, 12:56:26 am
Quote from: bplus on July 07, 2019, 11:24:54 pm
Hi Steve,

Line method leaves gaps near outer edge in odd places, math rounding or something, just enough to make the drawing imperfect. Maybe I am missing something...

Oh hey! Try outer Radius and then one or two layers down to catch the gaps with way less steps, maybe?

It has something to do with rounding and line; I'm certain of it now.  :D

Here's an easy solution for line drawing with circles which should work for you (I'd think):
Code: QB64: [Select]
  2. SCREEN _NEWIMAGE(800, 800, 32)
  4.  
  5. Radius = 400
  6.  
  7. w = (_WIDTH / 2)
  8. h = (_HEIGHT / 2)
  9. FOR i = 0 TO _PI(2) STEP 1 / Radius
  10.     x = w + SIN(i) * Radius
  11.     y = h + COS(i) * Radius
  12.     LINE (x, y)-(w, h), -1
  13.     LINE (x + 1, y)-(w, h), -1
  15.  

One line drawn leaves gaps in the circle, but drawing another, simply offset by a single pixel, makes certain all those gaps are taken care of.  At least, it appears to me as if it does.
Title: Re: One more pattern challenge
Post by: SMcNeill on July 08, 2019, 01:23:47 am
As for your demo, try this and see how it performs for you:

Code: [Select]
OPTION _EXPLICIT
_TITLE "Rainbow Ring" 'bplus 2019-07-07
'DoubleRing mod by Steve 2019-07-08
' QB64 X 64 v 1.3
CONST xmax = 1220, ymax = 760, PI = 3.141592653589793
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 0
RANDOMIZE TIMER
DIM SHARED graphicsCalls AS _INTEGER64
DIM offset, start, test

start = TIMER
FOR test = 1 TO 20
    CLS
    offset = offset + PI / 120

    'compare two subs  comment out one or the other next 2 lines
    'rainbowRing xmax / 2, ymax / 2, 250, 50, offset
    'ring xmax / 2, ymax / 2, 250, 50, offset
    Doublering xmax / 2, ymax / 2, 250, 50, offset


    _DISPLAY
NEXT
PRINT "The number of graphics calls was:"; graphicsCalls
PRINT "Time:"; TIMER - start
_DISPLAY

SUB Doublering (x, y, outerR, innerR, offset)
    DIM pm2, pd3, pd6, a, aStep, x1, y1, x2, y2, c AS _UNSIGNED LONG
    pm2 = PI * 2
    pd3 = PI / 3
    pd6 = pd3 / 2 'pd6 aligns red at 90 degrees bottom of circle and light almost white cyan at top, looks good Steve!

    'aStep = 1 / (20.1 * pm2 * outerR) 'this is what I used for screen shot
    FOR a = 0 TO pm2 STEP 1 / outerR ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<  is this the flaw to this method????
        x1 = x + outerR * COS(a - pd6 + offset)
        y1 = y + outerR * SIN(a - pd6 + offset)
        x2 = x + innerR * COS(a - pd6 + offset)
        y2 = y + innerR * SIN(a - pd6 + offset)
        IF a < pd3 THEN
            c = _RGB32(255 * a / pd3, 255, 0)
        ELSEIF a < 2 * pd3 THEN
            c = _RGB32(255, 255 - 255 * (a - pd3) / pd3, 0)
        ELSEIF a < 3 * pd3 THEN
            c = _RGB32(255, 0, 255 * (a - 2 * pd3) / pd3)
        ELSEIF a < 4 * pd3 THEN
            c = _RGB32(255 - 255 * (a - 3 * pd3) / pd3, 0, 255)
        ELSEIF a < 5 * pd3 THEN
            c = _RGB32(0, 255 * (a - 4 * pd3) / pd3, 255)
        ELSE
            c = _RGB32(0, 255, 255 - 255 * (a - 5 * pd3) / pd3)
        END IF
        LINE (x1, y1)-(x2, y2), c
        LINE (x1 + 1, y1)-(x2 + 1, y2), c
        graphicsCalls = graphicsCalls + 1
    NEXT
END SUB

SUB rainbowRing (x, y, outerR, innerR, offset) 'no lines, do arc/circle style
    DIM pm2, pd3, pd6, r, a, aStep, x1, y1, x2, y2, c AS _UNSIGNED LONG
    pm2 = PI * 2
    pd3 = PI / 3
    pd6 = pd3 / 2 'pd6 aligns red at 90 degrees bottom of circle and light almost white cyan at top, looks good Steve!


    FOR r = innerR TO outerR 'step 1? seems to be OK

        'how many pixels 2*PI*R around the curve = how many steps needed to take around circle?
        'aStep = 1 / (pm2 * outerR)  'nope not efficient
        aStep = 1 / (pm2 * r) '<<<<  EDIT/UPDATE:  aha!!   this makes all the difference !!! (first tried outerR)


        FOR a = 0 TO pm2 STEP aStep '>>>>>>>>>>> yeah seems to cover well and does not seem like allot
            x1 = x + r * COS(a - pd6 + offset)
            y1 = y + r * SIN(a - pd6 + offset)
            IF a < pd3 THEN
                c = _RGB32(255 * a / pd3, 255, 0)
            ELSEIF a < 2 * pd3 THEN
                c = _RGB32(255, 255 - 255 * (a - pd3) / pd3, 0)
            ELSEIF a < 3 * pd3 THEN
                c = _RGB32(255, 0, 255 * (a - 2 * pd3) / pd3)
            ELSEIF a < 4 * pd3 THEN
                c = _RGB32(255 - 255 * (a - 3 * pd3) / pd3, 0, 255)
            ELSEIF a < 5 * pd3 THEN
                c = _RGB32(0, 255 * (a - 4 * pd3) / pd3, 255)
            ELSE
                c = _RGB32(0, 255, 255 - 255 * (a - 5 * pd3) / pd3)
            END IF
            PSET (x1, y1), c
            graphicsCalls = graphicsCalls + 1
        NEXT
    NEXT
END SUB

SUB ring (x, y, outerR, innerR, offset)
    DIM pm2, pd3, pd6, a, aStep, x1, y1, x2, y2, c AS _UNSIGNED LONG
    pm2 = PI * 2
    pd3 = PI / 3
    pd6 = pd3 / 2 'pd6 aligns red at 90 degrees bottom of circle and light almost white cyan at top, looks good Steve!

    'aStep = 1 / (20.1 * pm2 * outerR) 'this is what I used for screen shot
    FOR a = 0 TO pm2 STEP .00005 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<  is this the flaw to this method????
        x1 = x + outerR * COS(a - pd6 + offset)
        y1 = y + outerR * SIN(a - pd6 + offset)
        x2 = x + innerR * COS(a - pd6 + offset)
        y2 = y + innerR * SIN(a - pd6 + offset)
        IF a < pd3 THEN
            c = _RGB32(255 * a / pd3, 255, 0)
        ELSEIF a < 2 * pd3 THEN
            c = _RGB32(255, 255 - 255 * (a - pd3) / pd3, 0)
        ELSEIF a < 3 * pd3 THEN
            c = _RGB32(255, 0, 255 * (a - 2 * pd3) / pd3)
        ELSEIF a < 4 * pd3 THEN
            c = _RGB32(255 - 255 * (a - 3 * pd3) / pd3, 0, 255)
        ELSEIF a < 5 * pd3 THEN
            c = _RGB32(0, 255 * (a - 4 * pd3) / pd3, 255)
        ELSE
            c = _RGB32(0, 255, 255 - 255 * (a - 5 * pd3) / pd3)
        END IF
        LINE (x1, y1)-(x2, y2), c
        graphicsCalls = graphicsCalls + 1
    NEXT
END SUB

Ring takes 6 seconds on my PC, rainbowring takes 3.6 seconds, and DoubleRing takes all of 0.16 seconds.

Our step here is: 1 / outerR (or 1/250)
Compared vs: .00005 (or 1/20000)

Even if we count drawing double lines, that's 500 lines drawn, vs 20000 lines...

So, just a weeee bit faster.  ;)

It may change the dimensions of our circle by a pixel, but overall, it seems worth it just for the boost in performance speed.
Title: Re: One more pattern challenge
Post by: Petr on July 08, 2019, 08:57:51 am
Quote
Now, think of using that process in reverse to “unroll” your circle onto a flat piece of paper.

The circumference of that circle is, of course, 2 * Pi * Radius, so we absolutely know how many pixels we need for it — the LENGTH of that ring, if we “unrolled” it onto a piece of paper.

And, if we define how thick we want the ring to be (Radius for the whole circle, less than that for just a ring — like a donut — from that circle.), we can use that to define the definitive HEIGHT of the size of “paper” we’d unroll that ring upon.

With a length of 2 * Pi * Radius, and a height of Radius, we can “unroll” a complete circular surface onto a flat piece of paper.  Just go around, pixel-by-pixel, read one point on each ring in a clockwise direction, and plot its value sequentially to the points in a straight line; then move inwards on the circle, and downwards on your lines.

A round circle can be mapped to a square piece of paper, rather easily, using this method.  (Similar to the concept of mapping the globe onto a piece of paper.)

Reverse the process, and you can take a square image, and warp it back onto a circle again, easily enough.



Code: QB64: [Select]
  1. t$ = "You are right, Steve!"
  3.  
  4. SCREEN _NEWIMAGE(640, 480, 32)
  5.  
  7.     CLS
  8.     CircleText t$
  9.     rot = rot + .01
  10.     _DISPLAY
  11.     _LIMIT 20
  13.  
  14.  
  15. SUB CircleText (t$)
  16.     W = _PRINTWIDTH(t$) * _FONTWIDTH + 10
  17.     H = _FONTHEIGHT + 10
  18.  
  19.     virtual = _NEWIMAGE(W, H, 256)
  20.     _DEST virtual
  21.     CLS
  22.     _PRINTSTRING (5, 5), t$
  23.     _SOURCE virtual
  25.     FOR hh = 1 TO H - 1
  26.         g = _PI(2) / W
  27.         FOR ww = 1 TO W - 1
  28.             IF POINT(ww, hh) THEN k = &HFFFFFFFF ELSE k = &HFF000000
  29.             x = 320 + SIN(g * ww + rot) * 180 + hh
  30.             y = 240 + COS(g * ww + rot * 2) * 180 + hh
  31.             _DEST 0
  32.             PSET (x, y), k
  33.  
  34.     NEXT ww, hh
  35.     _DEST 0
  36.     _FREEIMAGE virtual
  38.  
  39.  
Title: Re: One more pattern challenge
Post by: SMcNeill on July 08, 2019, 09:59:49 am
A few changes to your code, Petr -- but it definitely seems as if you understand the concept quite well!  ;D

Code: [Select]
t$ = "You are right, Steve!"

SCREEN _NEWIMAGE(640, 480, 32)

CircleHandle = CreateImage(t$) 'Get a handle for our routine
x = 440: xdirection = -1
y = 240: ydirection = -1
DO
    CLS
    x = x + xdirection: IF x < 180 OR x > 440 THEN xdirection = -xdirection
    y = y + ydirection: IF y < 180 OR y > 280 THEN ydirection = -ydirection
    CircleText2 CircleHandle, x, y, rot, 180 'Add options to routine to make it more flexible.
    rot = rot + .01
    _DISPLAY
    _LIMIT 60
LOOP UNTIL _KEYHIT
_FREEIMAGE CircleHandle


FUNCTION CreateImage (t$)
    W = _PRINTWIDTH(t$) * _FONTWIDTH + 10
    H = _FONTHEIGHT + 10
    CreateImage = _NEWIMAGE(W, H, 256)
    _DEST CreateImage 'Change Dest
    CLS
    _PRINTSTRING (5, 5), t$
    _DEST 0 'Restore Dest
END FUNCTION

SUB CircleText2 (imagehandle, Xcenter, YCenter, Rot, Radius)
    'No need to build and rebuild the image, over and over, since we drew it and saved it in the previous routine.
    _SOURCE imagehandle 'Change Source
    W = _WIDTH(imagehandle): H = _HEIGHT(imagehandle) 'Get our sizes from whatever the image's is.
    DIM k AS _UNSIGNED LONG
    g = _PI(2) / W 'Moved to outside the loop since the value doesn't change
    FOR hh = 0 TO H - 1
        FOR ww = 0 TO W - 1
            IF POINT(ww, hh) THEN k = &HFFFFFFFF ELSE k = &HFFFF0000
            x = Xcenter + SIN(g * ww + Rot) * Radius + hh
            y = YCenter + COS(g * ww + Rot * 2) * Radius + hh
            'No need for DEST call, as we never change it
            PSET (x, y), k
            PSET (x + 1, y), k 'Remark out this line and see how performance is affected.
    NEXT ww, hh
    _SOURCE 0 'Restore Source
END SUB

Biggest issue I really saw was the lack of a _FREEIMAGE, when you were creating a _NEWIMAGE with each call to the sub, causing a memory leak which would crash the  program.
Title: Re: One more pattern challenge
Post by: Pete on July 08, 2019, 11:55:50 am
Petr went fishing... He added text!

Argh!!!!!!!

Now I have to learn this ____.

OK, here's my first shot at it. Tweaked a few lines to get this extended text message to print. What do you guys think?

Code: C: [Select]
  1. t$ = "If found, please return this collar to the QB64.org team at QB64.org."
  2.  
  3. SCREEN _NEWIMAGE(640, 480, 32)
  4.  
  5. CircleHandle = CreateImage(t$) 'Get a handle for our routine
  6. x = 440: xdirection = -1
  7. y = 240: ydirection = -1
  8. DO
  9.    CLS
  10.    x = x + xdirection: IF x < 180 OR x > 440 THEN xdirection = -xdirection
  11.    y = y + ydirection: IF y < 180 OR y > 280 THEN ydirection = -ydirection
  12.    CircleText2 CircleHandle, x, y, rot, 180 'Add options to routine to make it more flexible.
  13.     rot = rot + .01
  14.     _DISPLAY
  15.     _LIMIT 60
  16. LOOP UNTIL _KEYHIT
  17. _FREEIMAGE CircleHandle
  18.  
  19.  
  20. FUNCTION CreateImage (t$)
  21.     W = _PRINTWIDTH(t$) * .15 * _FONTWIDTH + 20
  22.     H = _FONTHEIGHT + 20
  23.     CreateImage = _NEWIMAGE(W, H, 256)
  24.     _DEST CreateImage 'Change Dest
  25.    CLS
  26.    _PRINTSTRING (5, 10), t$
  27.    _DEST 0 'Restore Dest
  28. END FUNCTION
  29.  
  30. SUB CircleText2 (imagehandle, Xcenter, YCenter, Rot, Radius)
  31.     'No need to build and rebuild the image, over and over, since we drew it and saved it in the previous routine.
  32.    _SOURCE imagehandle 'Change Source
  33.     W = _WIDTH(imagehandle): H = _HEIGHT(imagehandle) 'Get our sizes from whatever the image's is.
  34.     DIM k AS _UNSIGNED LONG
  35.     g = _PI(2) / W 'Moved to outside the loop since the value doesn't change
  36.     FOR hh = 0 TO H - 1
  37.         FOR ww = 0 TO W - 1
  38.             IF POINT(ww, hh) THEN k = &HFFFFFFFF ELSE k = &HFFFF0000
  39.             x = Xcenter + SIN(g * ww + Rot) * Radius + hh
  40.             y = YCenter + COS(g * ww + Rot * 2) * Radius + hh
  41.             'No need for DEST call, as we never change it
  42.            PSET (x, y), k
  43.            PSET (x + 1, y), k 'Remark out these 4 lines and see how performance is affected.
  44.             PSET (x - 1, y), k
  45.             PSET (x + 2, y), k
  46.             PSET (x - 2, y), k
  47.     NEXT ww, hh
  48.     _SOURCE 0 'Restore Source
  49. END SUB
  50.  

Pete
Title: Re: One more pattern challenge
Post by: bplus on July 08, 2019, 01:17:26 pm
Hi Steve,

Excellent speed improvement with your DoubleRing Mod to Ring or RainbowRing!

I spent morning trying to add it to all the other changes to match the screen shot in first post, the extra pixel to right did make a difference: the polys were touching the inner side of ring on left and ring thickness became hard to control, a little difference shows up big as you go farther into sequence.

Just when I thought I had all thickness and overlap of polys and rings I could live with, I discover the dang overlap of overall image was still wrong! Crap time for a break...

I think everyone has moved on anyway?

I did not follow the discussion with Petr so I am wondering if Pete's post is even remotely related to challenge? :D



 

Title: Re: One more pattern challenge
Post by: Pete on July 08, 2019, 01:33:55 pm
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
Title: Re: One more pattern challenge
Post by: bplus on July 08, 2019, 04:37:08 pm
Hi Pete,

Apparently I am overlap challenged :D

It is a nice bit of code you've worked out.
Title: Re: One more pattern challenge
Post by: OldMoses on July 08, 2019, 05:33:26 pm
I came real, real close.... if a black screen could be considered close. ;)
Title: Re: One more pattern challenge
Post by: SMcNeill on July 08, 2019, 05:44:17 pm
Quote from: OldMoses on July 08, 2019, 05:33:26 pm
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...
Title: Re: One more pattern challenge
Post by: bplus on July 08, 2019, 07:47:26 pm
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)
  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
  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
  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
  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!
  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
  100.  
Text Only | Text with Attachments