Author Topic: Fun With Circles  (Read 6500 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Fun With Circles
« on: January 09, 2021, 02:13:49 am »
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.     _LIMIT 30
  9.     _PUTIMAGE , image&
  10.     a$ = INKEY$
  11.     IF a$ = CHR$(27) THEN END
  12.         mouseX = _MOUSEX
  13.         mouseY = _MOUSEY
  14.         mouseLeftButton = _MOUSEBUTTON(1)
  15.     LOOP
  16.     IF mouseLeftButton THEN
  17.         FOR ttt = 1 TO 490
  18.             x(ttt) = 0
  19.             y(ttt) = 0
  20.             c(ttt) = 0
  21.             s(ttt) = 0
  22.         NEXT ttt
  23.         CLS
  24.     END IF
  25.     a = INT(RND * 100) + 1
  26.     IF a > 5 THEN
  27.         t = t + 1
  28.         IF t > 490 THEN t = 1
  29.         x(t) = mouseX
  30.         y(t) = mouseY
  31.         s(t) = 1
  32.         c1 = INT(RND * 205) + 50
  33.         c2 = INT(RND * 205) + 50
  34.         c3 = INT(RND * 205) + 50
  35.         c(t) = _RGB32(c1, c2, c3)
  36.     END IF
  37.     FOR tt = 1 TO 490
  38.         s(tt) = s(tt) + 1
  39.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
  40.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
  41.         skip:
  42.     NEXT tt
  43.     IF a$ = "c" OR a$ = "C" THEN
  44.         _AUTODISPLAY
  45.         image2& = _COPYIMAGE(0)
  46.         _CLIPBOARDIMAGE = image2&
  47.         _DISPLAY
  48.         _FREEIMAGE image2&
  49.     END IF
  50.     _DISPLAY
  51.     CLS
  52.  
Fun With Circles 2.jpg
* Fun With Circles 2.jpg (Filesize: 669.99 KB, Dimensions: 800x600, Views: 171)
Fun With Circles 3.jpg
* Fun With Circles 3.jpg (Filesize: 97.71 KB, Dimensions: 800x600, Views: 150)
« Last Edit: January 09, 2021, 02:15:20 am by SierraKen »

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Fun With Circles
« Reply #1 on: January 09, 2021, 03:53:46 am »
Nice effect. Try - DIM C(500) AS _UNSIGNED LONG  for more colors :)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Fun With Circles
« Reply #2 on: January 09, 2021, 01:15:18 pm »
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 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.     _LIMIT 30
  9.     _PUTIMAGE , image&
  10.     a$ = INKEY$
  11.     IF a$ = CHR$(27) THEN END
  12.         mouseX = _MOUSEX
  13.         mouseY = _MOUSEY
  14.         mouseLeftButton = _MOUSEBUTTON(1)
  15.     LOOP
  16.     IF mouseLeftButton THEN
  17.         FOR ttt = 1 TO 490
  18.             x(ttt) = 0
  19.             y(ttt) = 0
  20.             c(ttt) = 0
  21.             s(ttt) = 0
  22.         NEXT ttt
  23.         CLS
  24.     END IF
  25.     a = INT(RND * 100) + 1
  26.     IF a > 5 THEN
  27.         t = t + 1
  28.         IF t > 490 THEN t = 1
  29.         x(t) = mouseX
  30.         y(t) = mouseY
  31.         s(t) = 1
  32.         c1 = INT(RND * 205) + 50
  33.         c2 = INT(RND * 205) + 50
  34.         c3 = INT(RND * 205) + 50
  35.         c(t) = _RGB32(c1, c2, c3)
  36.     END IF
  37.     FOR tt = 1 TO 490
  38.         s(tt) = s(tt) + 1
  39.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
  40.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
  41.         skip:
  42.     NEXT tt
  43.     IF a$ = "c" OR a$ = "C" THEN
  44.         _AUTODISPLAY
  45.         image2& = _COPYIMAGE(0)
  46.         _CLIPBOARDIMAGE = image2&
  47.         _DISPLAY
  48.         _FREEIMAGE image2&
  49.     END IF
  50.     _DISPLAY
  51.     CLS
  52.  
Fun With Circles 4.jpg
* Fun With Circles 4.jpg (Filesize: 493.39 KB, Dimensions: 800x600, Views: 148)

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: Fun With Circles
« Reply #3 on: January 09, 2021, 01:36:23 pm »
Nice effect, @SierraKen.  Runs pretty smoothly here, even on my old laptop.

- Dav

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Fun With Circles
« Reply #4 on: January 09, 2021, 01:43:25 pm »
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.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Fun With Circles
« Reply #5 on: January 09, 2021, 01:52:52 pm »
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.
You're not done when it works, you're done when it's right.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Fun With Circles
« Reply #6 on: January 09, 2021, 04:51:38 pm »
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 :)

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Fun With Circles
« Reply #7 on: January 09, 2021, 06:35:10 pm »
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.

Marked as best answer by SierraKen on January 10, 2021, 12:38:24 pm

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Fun With Circles
« Reply #8 on: January 10, 2021, 05:38:11 pm »
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 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.     _LIMIT 30
  9.     a$ = INKEY$
  10.     IF a$ = CHR$(27) THEN END
  11.         mouseX = _MOUSEX
  12.         mouseY = _MOUSEY
  13.         mouseLeftButton = _MOUSEBUTTON(1)
  14.     LOOP
  15.     IF mouseLeftButton THEN
  16.         FOR ttt = 1 TO 490
  17.             x(ttt) = 0
  18.             y(ttt) = 0
  19.             c(ttt) = 0
  20.             s(ttt) = 0
  21.         NEXT ttt
  22.         CLS
  23.     END IF
  24.     a = INT(RND * 100) + 1
  25.     IF a > 5 THEN
  26.         t = t + 1
  27.         IF t > 490 THEN t = 1
  28.         x(t) = mouseX
  29.         y(t) = mouseY
  30.         s(t) = 1
  31.         c1 = INT(RND * 205) + 50
  32.         c2 = INT(RND * 205) + 50
  33.         c3 = INT(RND * 205) + 50
  34.         c(t) = _RGB32(c1, c2, c3)
  35.     END IF
  36.     FOR tt = 1 TO 490
  37.         s(tt) = s(tt) + 1
  38.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
  39.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
  40.         skip:
  41.     NEXT tt
  42.     IF a$ = "c" OR a$ = "C" THEN
  43.         _AUTODISPLAY
  44.         image2& = _COPYIMAGE(0)
  45.         _CLIPBOARDIMAGE = image2&
  46.         _DISPLAY
  47.         _FREEIMAGE image2&
  48.     END IF
  49.     _DISPLAY
  50.     CLS
  51.  

Offline NOVARSEG

  • Forum Resident
  • Posts: 509
    • View Profile
Re: Fun With Circles
« Reply #9 on: January 11, 2021, 02:06:19 am »
I did a few mods on it

Code: QB64: [Select]
  1. DIM x(500), y(500), s(500)
  2. DIM image AS LONG
  3. DIM image2 AS LONG
  4.  
  5.  
  6. image& = _NEWIMAGE(800, 600, 32)
  7. SCREEN image&
  8. image2& = _NEWIMAGE(800, 600, 32)
  9. _TITLE "Fun With Circles by SierraKen - C to Copy to Clipboard, Left Mouse Button Erases Screen."
  10.  
  11.     _LIMIT 30
  12.     a$ = INKEY$
  13.     IF a$ = CHR$(27) THEN END
  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.         rad = RND * _PI * 2
  30.  
  31.         t = t + 1
  32.         IF t > 490 THEN t = 1
  33.         x(t) = SIN(rad) * 500 'mouseX
  34.         y(t) = COS(rad) * 500 'mouseY
  35.         s(t) = 1
  36.         c1 = INT(RND * 205) + 50
  37.         c2 = INT(RND * 205) + 50
  38.         c3 = INT(RND * 205) + 50
  39.         c(t) = _RGB32(c1, c2, c3)
  40.     END IF
  41.     FOR tt = 1 TO 490
  42.         s(tt) = s(tt) * 1.012
  43.         IF x(tt) = 0 AND y(tt) = 0 THEN GOTO skip:
  44.         CIRCLE (x(tt), y(tt)), s(tt), c(tt)
  45.         skip:
  46.     NEXT tt
  47.     IF a$ = "c" OR a$ = "C" THEN
  48.         _AUTODISPLAY
  49.         image2& = _COPYIMAGE(0)
  50.         _CLIPBOARDIMAGE = image2&
  51.         _DISPLAY
  52.         _FREEIMAGE image2&
  53.     END IF
  54.     _DISPLAY
  55.     CLS
  56.  

Offline NOVARSEG

  • Forum Resident
  • Posts: 509
    • View Profile
Re: Fun With Circles
« Reply #10 on: January 11, 2021, 02:23:23 am »
another mod

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


Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Fun With Circles
« Reply #11 on: January 11, 2021, 11:58:53 am »
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.     CLS
  3.     FOR i = n - 1 TO 0 STEP -1
  4.         FOR j = 0 TO 15 STEP .5
  5.             CIRCLE (x(i), y(i)), i + j, _RGB32(127 + 127 * SIN(r * i), 127 + 127 * SIN(g * i), 127 + 127 * SIN(b * i))
  6.             x(i + 1) = x(i): y(i + 1) = y(i)
  7.         NEXT
  8.     NEXT
  9.     x(0) = _MOUSEX: y(0) = _MOUSEY
  10.     _DISPLAY
  11.  
  12.  

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Fun With Circles
« Reply #12 on: January 11, 2021, 12:02:11 pm »
This is a slinkee!

 
ss.png
You're not done when it works, you're done when it's right.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Fun With Circles
« Reply #13 on: January 11, 2021, 12:13:15 pm »
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.     LINE (0, 0)-(_WIDTH, _HEIGHT), &H20000000, BF
  3.     FOR i = n - 1 TO 0 STEP -1
  4.         FOR j = 0 TO 15 STEP .5
  5.             CIRCLE (x(i), y(i)), i + j, _RGB32(127 + 127 * SIN(r * i), 127 + 127 * SIN(g * i), 127 + 127 * SIN(b * i), 80)
  6.             x(i + 1) = x(i): y(i + 1) = y(i)
  7.         NEXT
  8.     NEXT
  9.     x(0) = _MOUSEX: y(0) = _MOUSEY
  10.     _DISPLAY
  11.  
  12.  


Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Fun With Circles
« Reply #14 on: January 11, 2021, 12:14:41 pm »
You're getting a lot of mileage out of this palette rotation trick!

Have you considered writing an article on it?
You're not done when it works, you're done when it's right.