Author Topic: One more pattern challenge  (Read 7568 times)

0 Members and 1 Guest are viewing this topic.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: One more pattern challenge
« Reply #15 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: One more pattern challenge
« Reply #16 on: July 07, 2019, 05:35:28 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.). ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: One more pattern challenge
« Reply #17 on: July 07, 2019, 05:40:19 pm »
...But all the really good songs were made about West Virginia.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: One more pattern challenge
« Reply #18 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.

Offline bplus

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

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)
« Last Edit: July 07, 2019, 11:16:34 pm by bplus »

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: One more pattern challenge
« Reply #20 on: July 07, 2019, 11:09:47 pm »
14.45 seconds on my high speed Karnak The Magnificent laptop.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: One more pattern challenge
« Reply #21 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!  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: One more pattern challenge
« Reply #22 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?

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: One more pattern challenge
« Reply #23 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: One more pattern challenge
« Reply #24 on: July 08, 2019, 12:56:26 am »
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]
  1. SCREEN _NEWIMAGE(800, 800, 32)
  2.  
  3. Radius = 400
  4.  
  5. w = (_WIDTH / 2)
  6. h = (_HEIGHT / 2)
  7. FOR i = 0 TO _PI(2) STEP 1 / Radius
  8.     x = w + SIN(i) * Radius
  9.     y = h + COS(i) * Radius
  10.     LINE (x, y)-(w, h), -1
  11.     LINE (x + 1, y)-(w, h), -1
  12.  

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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: One more pattern challenge
« Reply #25 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.
« Last Edit: July 08, 2019, 01:25:14 am by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: One more pattern challenge
« Reply #26 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!"
  2.  
  3. SCREEN _NEWIMAGE(640, 480, 32)
  4.  
  5.     CLS
  6.     CircleText t$
  7.     rot = rot + .01
  8.     _DISPLAY
  9.     _LIMIT 20
  10.  
  11.  
  12. SUB CircleText (t$)
  13.     W = _PRINTWIDTH(t$) * _FONTWIDTH + 10
  14.     H = _FONTHEIGHT + 10
  15.  
  16.     virtual = _NEWIMAGE(W, H, 256)
  17.     _DEST virtual
  18.     CLS
  19.     _PRINTSTRING (5, 5), t$
  20.     _SOURCE virtual
  21.     FOR hh = 1 TO H - 1
  22.         g = _PI(2) / W
  23.         FOR ww = 1 TO W - 1
  24.             IF POINT(ww, hh) THEN k = &HFFFFFFFF ELSE k = &HFF000000
  25.             x = 320 + SIN(g * ww + rot) * 180 + hh
  26.             y = 240 + COS(g * ww + rot * 2) * 180 + hh
  27.             _DEST 0
  28.             PSET (x, y), k
  29.  
  30.     NEXT ww, hh
  31.     _DEST 0
  32.     _FREEIMAGE virtual
  33.  
  34.  
« Last Edit: July 08, 2019, 09:57:58 am by Petr »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: One more pattern challenge
« Reply #27 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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: One more pattern challenge
« Reply #28 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
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: One more pattern challenge
« Reply #29 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



 

« Last Edit: July 08, 2019, 01:19:40 pm by bplus »