Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on January 09, 2021, 02:13:49 am

Title: Fun With Circles
Post by: SierraKen 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.  
Title: Re: Fun With Circles
Post by: Petr on January 09, 2021, 03:53:46 am
Nice effect. Try - DIM C(500) AS _UNSIGNED LONG  for more colors :)
Title: Re: Fun With Circles
Post by: SierraKen 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.  
Title: Re: Fun With Circles
Post by: Dav on January 09, 2021, 01:36:23 pm
Nice effect, @SierraKen.  Runs pretty smoothly here, even on my old laptop.

- Dav
Title: Re: Fun With Circles
Post by: bplus 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.
Title: Re: Fun With Circles
Post by: 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.
Title: Re: Fun With Circles
Post by: bplus 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 :)
Title: Re: Fun With Circles
Post by: SierraKen 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.
Title: Re: Fun With Circles
Post by: SierraKen 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.  
Title: Re: Fun With Circles
Post by: NOVARSEG 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.  
Title: Re: Fun With Circles
Post by: NOVARSEG 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

Title: Re: Fun With Circles
Post by: bplus 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.  
Title: Re: Fun With Circles
Post by: STxAxTIC on January 11, 2021, 12:02:11 pm
This is a slinkee!

 
Title: Re: Fun With Circles
Post by: bplus 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.  

Title: Re: Fun With Circles
Post by: STxAxTIC 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?
Title: Re: Fun With Circles
Post by: SierraKen on January 11, 2021, 12:18:57 pm
Pretty neat NOVARSEG!

B+, you always impress me, I could never top that. LOL Yep Static, looks like a Slinkee. I think we all did Slinkees last year if I recall and someone, probably B+ wanted me to make one that walks. So I did. It's not as good as this one though with the mouse that he made.
Title: Re: Fun With Circles
Post by: bplus on January 11, 2021, 12:27:06 pm
Ha! I can't quit ;-)) another 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
  11.     x(0) = _WIDTH / 2 + 200 * COS(a): y(0) = _HEIGHT / 2 + 200 * SIN(a)
  12.     a = a + _PI(1 / 22)
  13.     _DISPLAY
  15.  

That surely beats MS wait cycler!
Title: Re: Fun With Circles
Post by: Dav on January 11, 2021, 01:16:29 pm
Great stuff, @bplus!  I swear if I tried to do effects like that I'd probably bloat it out to 100's of lines of nonesense.  Your code is so clear and tidy.

- Dav
Title: Re: Fun With Circles
Post by: bplus on January 11, 2021, 04:35:43 pm
Thanks Dav and Ken.

Quote
I could never top that.
Ken never say never, I started out doing same thing as you on forums long gone 5-6 years ago doing little mods with programs after QB4.5 and early VB in early and mid 90's and maybe NOVARSEG may be so inclined as well :)

As STx said, you learn a couple of tricks... :)
Title: Re: Fun With Circles
Post by: SierraKen on January 11, 2021, 06:25:47 pm
Thanks B+. :) I'm thinking about making some kind of text game or adventure next. It doesn't take much skill but a lot of time. I made one Dungeon game back in the 90's with QBasic but it only has around 10 screens (places). But I used DATA lines to make each graphic on the screen. I'm thinking about it anyway. :)
Text Only | Text with Attachments