Fun With Circles

[SierraKen]

This might have been made before, but I've always wanted to make this. You use your mouse and it starts as a dot and as time goes on that dot makes a  larger and larger circle. And at the same time more of these dots and circles are made non-stop. Wherever the mouse is is where they start out at. I added the ability to copy the image to the clipboard so you can paste it to your graphics program and do whatever you want with it. Here are 2 pictures I made too. Enjoy!

Code: QB64: [Select]

1. DIM x(500), y(500), c(500), s(500)
2. DIM image AS LONG
3. DIM image2 AS LONG
4. image& = _NEWIMAGE(800, 600, 32)
5. SCREEN image&
6. image2& = _NEWIMAGE(800, 600, 32)
7. _TITLE "Fun With Circles by SierraKen - C to Copy to Clipboard, Left Mouse Button Erases Screen."
8. DO
9.     _LIMIT 30
10.     _PUTIMAGE , image&
11.     a$ = INKEY$
12.     IF a$ = CHR$(27) THEN END
13.     DO WHILE _MOUSEINPUT
14.         mouseX = _MOUSEX
15.         mouseY = _MOUSEY
16.         mouseLeftButton = _MOUSEBUTTON(1)
17.     LOOP
18.     IF mouseLeftButton THEN
19.         FOR ttt = 1 TO 490
20.             x(ttt) = 0
21.             y(ttt) = 0
22.             c(ttt) = 0
23.             s(ttt) = 0
24.         NEXT ttt
25.         CLS
26.     END IF
27.     a = INT(RND * 100) + 1
28.     IF a > 5 THEN
29.         t = t + 1
30.         IF t > 490 THEN t = 1
31.         x(t) = mouseX
32.         y(t) = mouseY
33.         s(t) = 1
34.         c1 = INT(RND * 205) + 50
35.         c2 = INT(RND * 205) + 50
36.         c3 = INT(RND * 205) + 50
37.         c(t) = _RGB32(c1, c2, c3)
38.     END IF
39.     FOR tt = 1 TO 490
40.         s(tt) = s(tt) + 1
41.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
42.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
43.         skip:
44.     NEXT tt
45.     IF a$ = "c" OR a$ = "C" THEN
46.         _AUTODISPLAY
47.         image2& = _COPYIMAGE(0)
48.         _CLIPBOARDIMAGE = image2&
49.         _DISPLAY
50.         _FREEIMAGE image2&
51.     END IF
52.     _DISPLAY
53.     CLS
54. LOOP
55.  

[Petr]

Nice effect. Try - DIM C(500) AS _UNSIGNED LONG  for more colors :)

[SierraKen]

Thanks Petr! Works even better now. :) Here is the update with a new picture.

Code: QB64: [Select]

1. DIM x(500), y(500), s(500)
2. DIM c(500) AS _UNSIGNED LONG
3. DIM image AS LONG
4. DIM image2 AS LONG
5. image& = _NEWIMAGE(800, 600, 32)
6. SCREEN image&
7. image2& = _NEWIMAGE(800, 600, 32)
8. _TITLE "Fun With Circles by SierraKen - C to Copy to Clipboard, Left Mouse Button Erases Screen."
9. DO
10.     _LIMIT 30
11.     _PUTIMAGE , image&
12.     a$ = INKEY$
13.     IF a$ = CHR$(27) THEN END
14.     DO WHILE _MOUSEINPUT
15.         mouseX = _MOUSEX
16.         mouseY = _MOUSEY
17.         mouseLeftButton = _MOUSEBUTTON(1)
18.     LOOP
19.     IF mouseLeftButton THEN
20.         FOR ttt = 1 TO 490
21.             x(ttt) = 0
22.             y(ttt) = 0
23.             c(ttt) = 0
24.             s(ttt) = 0
25.         NEXT ttt
26.         CLS
27.     END IF
28.     a = INT(RND * 100) + 1
29.     IF a > 5 THEN
30.         t = t + 1
31.         IF t > 490 THEN t = 1
32.         x(t) = mouseX
33.         y(t) = mouseY
34.         s(t) = 1
35.         c1 = INT(RND * 205) + 50
36.         c2 = INT(RND * 205) + 50
37.         c3 = INT(RND * 205) + 50
38.         c(t) = _RGB32(c1, c2, c3)
39.     END IF
40.     FOR tt = 1 TO 490
41.         s(tt) = s(tt) + 1
42.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
43.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
44.         skip:
45.     NEXT tt
46.     IF a$ = "c" OR a$ = "C" THEN
47.         _AUTODISPLAY
48.         image2& = _COPYIMAGE(0)
49.         _CLIPBOARDIMAGE = image2&
50.         _DISPLAY
51.         _FREEIMAGE image2&
52.     END IF
53.     _DISPLAY
54.     CLS
55. LOOP
56.  

[Dav]

Nice effect, @SierraKen.  Runs pretty smoothly here, even on my old laptop.

- Dav

[bplus]

Uncanny, I did about the same thing back in 2015, https://raw.githubusercontent.com/smallbasic/smallbasic.samples/master/graphics%202/follow%20me.bas

only didn't need images.

[STxAxTIC]

It's because these kinds of outputs are discoveries, not so much inventions. I hold firmly that if any one of us were stuck working with QB64 on a desert island for 10000 years, he/she would eventually write all the same programs as any other person would.

[bplus]

It's because these kinds of outputs are discoveries, not so much inventions. I hold firmly that if any one of us were stuck working with QB64 on a desert island for 10000 years, he/she would eventually write all the same programs as any other person would.

Yeah I am seeing this in MasterGy's latest, his a little better though :)

[SierraKen]

LOL awesome B+! The old BASIC compilers were interesting, I had the only ASIC 5.0 programs website online in the 90's (besides All Basic Code's). That used GW-BASIC code and compiled to the old DOS .com unless you changed it to .exe. It was hard to use though.
Yeah I figured that if someone has made this already, they probably never added a _CLIPBOARDIMAGE so people can add graphics to it and save it with their graphics program.

[SierraKen]

I didn't need the _PUTIMAGE line in the LOOP, so I removed it. 

Code: QB64: [Select]

1. DIM x(500), y(500), s(500)
2. DIM c(500) AS _UNSIGNED LONG
3. DIM image AS LONG
4. DIM image2 AS LONG
5. image& = _NEWIMAGE(800, 600, 32)
6. SCREEN image&
7. image2& = _NEWIMAGE(800, 600, 32)
8. _TITLE "Fun With Circles by SierraKen - C to Copy to Clipboard, Left Mouse Button Erases Screen."
9. DO
10.     _LIMIT 30
11.     a$ = INKEY$
12.     IF a$ = CHR$(27) THEN END
13.     DO WHILE _MOUSEINPUT
14.         mouseX = _MOUSEX
15.         mouseY = _MOUSEY
16.         mouseLeftButton = _MOUSEBUTTON(1)
17.     LOOP
18.     IF mouseLeftButton THEN
19.         FOR ttt = 1 TO 490
20.             x(ttt) = 0
21.             y(ttt) = 0
22.             c(ttt) = 0
23.             s(ttt) = 0
24.         NEXT ttt
25.         CLS
26.     END IF
27.     a = INT(RND * 100) + 1
28.     IF a > 5 THEN
29.         t = t + 1
30.         IF t > 490 THEN t = 1
31.         x(t) = mouseX
32.         y(t) = mouseY
33.         s(t) = 1
34.         c1 = INT(RND * 205) + 50
35.         c2 = INT(RND * 205) + 50
36.         c3 = INT(RND * 205) + 50
37.         c(t) = _RGB32(c1, c2, c3)
38.     END IF
39.     FOR tt = 1 TO 490
40.         s(tt) = s(tt) + 1
41.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
42.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
43.         skip:
44.     NEXT tt
45.     IF a$ = "c" OR a$ = "C" THEN
46.         _AUTODISPLAY
47.         image2& = _COPYIMAGE(0)
48.         _CLIPBOARDIMAGE = image2&
49.         _DISPLAY
50.         _FREEIMAGE image2&
51.     END IF
52.     _DISPLAY
53.     CLS
54. LOOP
55.  

[NOVARSEG]

I did a few mods on it

Code: QB64: [Select]

1. DIM x(500), y(500), s(500)
2. DIM c(500) AS _UNSIGNED LONG
3. DIM image AS LONG
4. DIM image2 AS LONG
5.  
6. DIM rad AS SINGLE
7.  
8. image& = _NEWIMAGE(800, 600, 32)
9. SCREEN image&
10. image2& = _NEWIMAGE(800, 600, 32)
11. _TITLE "Fun With Circles by SierraKen - C to Copy to Clipboard, Left Mouse Button Erases Screen."
12. _FULLSCREEN
13.  
14. DO
15.     _LIMIT 30
16.     a$ = INKEY$
17.     IF a$ = CHR$(27) THEN END
18.     DO WHILE _MOUSEINPUT
19.         mouseX = _MOUSEX
20.         mouseY = _MOUSEY
21.         mouseLeftButton = _MOUSEBUTTON(1)
22.     LOOP
23.     IF mouseLeftButton THEN
24.         FOR ttt = 1 TO 490
25.             x(ttt) = 0
26.             y(ttt) = 0
27.             c(ttt) = 0
28.             s(ttt) = 0
29.         NEXT ttt
30.         CLS
31.     END IF
32.     a = INT(RND * 100) + 1
33.     IF a > 5 THEN
34.         rad = RND * _PI * 2
35.  
36.         t = t + 1
37.         IF t > 490 THEN t = 1
38.         x(t) = SIN(rad) * 500 'mouseX
39.         y(t) = COS(rad) * 500 'mouseY
40.         s(t) = 1
41.         c1 = INT(RND * 205) + 50
42.         c2 = INT(RND * 205) + 50
43.         c3 = INT(RND * 205) + 50
44.         c(t) = _RGB32(c1, c2, c3)
45.     END IF
46.     FOR tt = 1 TO 490
47.         s(tt) = s(tt) * 1.012
48.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
49.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
50.         skip:
51.     NEXT tt
52.     IF a$ = "c" OR a$ = "C" THEN
53.         _AUTODISPLAY
54.         image2& = _COPYIMAGE(0)
55.         _CLIPBOARDIMAGE = image2&
56.         _DISPLAY
57.         _FREEIMAGE image2&
58.     END IF
59.     _DISPLAY
60.     CLS
61. LOOP
62.  

[NOVARSEG]

another mod

Code: QB64: [Select]

1. DIM x(500), y(500), s(500)
2. DIM c(500) AS _UNSIGNED LONG
3. DIM image AS LONG
4. DIM image2 AS LONG
5.  
6. DIM rad AS SINGLE
7.  
8. image& = _NEWIMAGE(800, 600, 32)
9. SCREEN image&
10. image2& = _NEWIMAGE(800, 600, 32)
11. _TITLE "Fun With Circles by SierraKen - C to Copy to Clipboard, Left Mouse Button Erases Screen."
12. _FULLSCREEN
13.  
14. DO
15.     _LIMIT 30
16.     a$ = INKEY$
17.     IF a$ = CHR$(27) THEN END
18.     DO WHILE _MOUSEINPUT
19.         mouseX = _MOUSEX
20.         mouseY = _MOUSEY
21.         mouseLeftButton = _MOUSEBUTTON(1)
22.     LOOP
23.     IF mouseLeftButton THEN
24.         FOR ttt = 1 TO 190
25.             x(ttt) = 0
26.             y(ttt) = 0
27.             c(ttt) = 0
28.             s(ttt) = 0
29.         NEXT ttt
30.         CLS
31.     END IF
32.     a = INT(RND * 100) + 1
33.     IF a > 55 THEN
34.         rad = RND * _PI * 2
35.  
36.         t = t + 1
37.         IF t > 190 THEN t = 1
38.         x(t) = SIN(rad) * 500 'mouseX
39.         y(t) = COS(rad) * 500 'mouseY
40.         s(t) = 1
41.         c1 = INT(RND * 205) + 50
42.         c2 = INT(RND * 205) + 50
43.         c3 = INT(RND * 205) + 50
44.         c(t) = _RGB32(c1, c2, c3)
45.     END IF
46.     FOR tt = 1 TO 190
47.         s(tt) = s(tt) * 1.016
48.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
49.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
50.         skip:
51.     NEXT tt
52.     IF a$ = "c" OR a$ = "C" THEN
53.         _AUTODISPLAY
54.         image2& = _COPYIMAGE(0)
55.         _CLIPBOARDIMAGE = image2&
56.         _DISPLAY
57.         _FREEIMAGE image2&
58.     END IF
59.     _DISPLAY
60.     CLS
61. LOOP

[bplus]

Here is my update to Follow Me:

Code: QB64: [Select]

1. n = 200: r = RND * RND: g = RND * RND: b = RND * RND: REDIM x(n), y(n) ' b+ update follow me 2021-01-11
2. SCREEN _NEWIMAGE(800, 600, 32): _DELAY .25: _SCREENMOVE _MIDDLE: RANDOMIZE TIMER: _MOUSEHIDE
3. WHILE 1
4.     CLS
5.     FOR i = n - 1 TO 0 STEP -1
6.         FOR j = 0 TO 15 STEP .5
7.             CIRCLE (x(i), y(i)), i + j, _RGB32(127 + 127 * SIN(r * i), 127 + 127 * SIN(g * i), 127 + 127 * SIN(b * i))
8.             x(i + 1) = x(i): y(i + 1) = y(i)
9.         NEXT
10.     NEXT
11.     WHILE _MOUSEINPUT: WEND
12.     x(0) = _MOUSEX: y(0) = _MOUSEY
13.     _DISPLAY
14. WEND
15.  
16.  

[STxAxTIC]

This is a slinkee!

 

[bplus]

Here is a variation:

Code: QB64: [Select]

1. n = 200: r = RND * RND: g = RND * RND: b = RND * RND: REDIM x(n), y(n) ' b+ update follow me 2021-01-11
2. SCREEN _NEWIMAGE(800, 600, 32): _DELAY .25: _SCREENMOVE _MIDDLE: RANDOMIZE TIMER: _MOUSEHIDE: CLS
3. WHILE 1
4.     LINE (0, 0)-(_WIDTH, _HEIGHT), &H20000000, BF
5.     FOR i = n - 1 TO 0 STEP -1
6.         FOR j = 0 TO 15 STEP .5
7.             CIRCLE (x(i), y(i)), i + j, _RGB32(127 + 127 * SIN(r * i), 127 + 127 * SIN(g * i), 127 + 127 * SIN(b * i), 80)
8.             x(i + 1) = x(i): y(i + 1) = y(i)
9.         NEXT
10.     NEXT
11.     WHILE _MOUSEINPUT: WEND
12.     x(0) = _MOUSEX: y(0) = _MOUSEY
13.     _DISPLAY
14. WEND
15.  
16.  

[STxAxTIC]

You're getting a lot of mileage out of this palette rotation trick!

Have you considered writing an article on it?