« previous next »
Pages: [1] 2   Go Down

Author Topic: Fun With Circles  (Read 6738 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."
  9.     _LIMIT 30
  10.     _PUTIMAGE , image&
  11.     a$ = INKEY$
  12.     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.         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
  55.  
Fun With Circles 2.jpg
* Fun With Circles 2.jpg (Filesize: 669.99 KB, Dimensions: 800x600, Views: 176)
Fun With Circles 3.jpg
* Fun With Circles 3.jpg (Filesize: 97.71 KB, Dimensions: 800x600, Views: 155)
« Last Edit: January 09, 2021, 02:15:20 am by SierraKen »
Logged

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 :)
Logged

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)
  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."
  10.     _LIMIT 30
  11.     _PUTIMAGE , image&
  12.     a$ = INKEY$
  13.     IF a$ = CHR$(27) THEN END
  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
  56.  
Fun With Circles 4.jpg
* Fun With Circles 4.jpg (Filesize: 493.39 KB, Dimensions: 800x600, Views: 153)
Logged

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
Logged

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.
Logged

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.
Logged
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 »
Quote from: STxAxTIC 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.

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

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.
Logged
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)
  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."
  10.     _LIMIT 30
  11.     a$ = INKEY$
  12.     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.         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
  55.  
Logged

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)
  3. DIM image AS LONG
  4. DIM image2 AS LONG
  5.  
  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."
  13.  
  15.     _LIMIT 30
  16.     a$ = INKEY$
  17.     IF a$ = CHR$(27) THEN END
  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
  62.  
Logged

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)
  3. DIM image AS LONG
  4. DIM image2 AS LONG
  5.  
  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."
  13.  
  15.     _LIMIT 30
  16.     a$ = INKEY$
  17.     IF a$ = CHR$(27) THEN END
  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

Logged

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
  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
  12.     x(0) = _MOUSEX: y(0) = _MOUSEY
  13.     _DISPLAY
  15.  
  16.  
Logged

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
Logged
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
  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
  12.     x(0) = _MOUSEX: y(0) = _MOUSEY
  13.     _DISPLAY
  15.  
  16.  

Logged

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?
Logged
You're not done when it works, you're done when it's right.
Pages: [1] 2   Go Up
« previous next »