Makes a Globe with Lines and Points

[SierraKen]

Use the mouse wheel to keep adding more lines and more connections making the circle more circular and more lines connecting the points.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(600, 600, 32)
2. DIM xx(5000), yy(5000)
3. _LIMIT 100
4. points = 3
5. GOSUB drawing:
6.  
7. DO
8.     mouseWheel = 0
9.     DO WHILE _MOUSEINPUT
10.         mouseWheel = mouseWheel + _MOUSEWHEEL
11.     LOOP
12.     IF mouseWheel = 1 THEN points = points + 1: CLS: GOSUB drawing
13.     IF mouseWheel = -1 THEN points = points - 1: CLS: GOSUB drawing:
14.     a$ = INKEY$
15.     IF a$ = CHR$(27) THEN END
16. LOOP
17.  
18. drawing:
19. mouseWheel = 0
20. IF points < 1 THEN points = 1
21. IF points > 50 THEN points = 50
22. FOR a = 1 TO 1200 * points STEP 20
23.     seconds = seconds + 5 / points
24.     sec = (60 - seconds) * 6 + 180
25.     x = INT(SIN(sec / 180 * 3.141592) * 180) + 300
26.     y = INT(COS(sec / 180 * 3.141592) * 180) + 300
27.     t = t + 1
28.     xx(t) = x
29.     yy(t) = y
30.     CIRCLE (x, y), 2, _RGB32(255, 255, 255)
31. NEXT a
32. seconds = 0
33.  
34. FOR t2 = 1 TO points * 10
35.     FOR tt = t2 TO (11 + t2) * points STEP t2
36.         IF xx(tt + t2) < 10 OR yy(tt + t2) < 10 THEN GOTO skip:
37.         LINE (xx(tt), yy(tt))-(xx(tt + t2), yy(tt + t2)), _RGB32(255, 255, 255)
38.     NEXT tt
39. NEXT t2
40.  
41. skip:
42. FOR e = 1 TO t
43.     xx(t) = 0
44.     yy(t) = 0
45. NEXT e
46. points$ = STR$(points)
47. _TITLE "Use the mouse wheel (1-50): " + points$
48. t = 0
49. tt = 0
50. _DISPLAY
51. RETURN
52.  

[SpriggsySpriggs]

Mmmm..... Spider-web doughnut

[SierraKen]

LOLOL :)

[johnno56]

Mmm... Donuts...

[loudar]

I modified it a little bit to be able to change the steps! The higher the steps, the more of a circle you get. With less steps it more and more looks like a donut. Tasty!

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(600, 600, 32)
2. _LIMIT 100
3. points = 3
4. steps = 10
5. DIM xx(1200 * points), yy(1200 * points)
6. GOSUB drawing:
7.  
8. DO
9.     mouseWheel = 0
10.     DO WHILE _MOUSEINPUT
11.         mouseWheel = mouseWheel + _MOUSEWHEEL
12.     LOOP
13.     IF mouseWheel = 1 THEN points = points + 1: CLS: GOSUB drawing
14.     IF mouseWheel = -1 THEN points = points - 1: CLS: GOSUB drawing:
15.     a$ = INKEY$
16.     IF a$ = CHR$(27) THEN END
17. LOOP
18.  
19. drawing:
20. mouseWheel = 0
21. IF points < 1 THEN points = 1
22. IF points > 50 THEN points = 50
23. FOR a = 1 TO 1200 * points STEP steps
24.     seconds = seconds + 5 / points
25.     sec = (60 - seconds) * 6 + 180
26.     x = INT(SIN(sec / 180 * 3.141592) * 180) + 300
27.     y = INT(COS(sec / 180 * 3.141592) * 180) + 300
28.     t = t + 1
29.     xx(t) = x
30.     yy(t) = y
31.     'CIRCLE (x, y), 2, _RGB32(255, 255, 255)
32. NEXT a
33. seconds = 0
34.  
35. bounces = steps + points - 1
36. FOR t2 = 1 TO points * bounces
37.     FOR tt = t2 TO ((bounces + 1) + t2) * points STEP t2
38.         IF xx(tt + t2) < bounces OR yy(tt + t2) < bounces THEN GOTO skip:
39.         LINE (xx(tt), yy(tt))-(xx(tt + t2), yy(tt + t2)), _RGB32(255, 255, 255)
40.     NEXT tt
41. NEXT t2
42.  
43. skip:
44. FOR e = 1 TO t
45.     xx(t) = 0
46.     yy(t) = 0
47. NEXT e
48. points$ = STR$(points)
49. _TITLE "Use the mouse wheel (1-50): " + points$
50. t = 0
51. tt = 0
52. _DISPLAY
53. RETURN

[SierraKen]

Pretty cool loudar, but I get line 38 is out of range when I go from 1 to 50. DIM probably just needs more added to it.

[SierraKen]

Oh I see, DIM isn't in the loop so points on the DIM line will always only be 3. But you can't put DIM in the loop to begin with, so I suggest just making a very high value for the DIM line.

[SierraKen]

Here is another design that is pretty far-out looking. All I did was add: * points at the end of the STEP line in line 35.
Move the mouse wheel slowly, you can see that it looks like a sci-fi portal. :) I added a picture below.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(600, 600, 32)
2. DIM xx(5000), yy(5000)
3. _LIMIT 100
4. points = 3
5. GOSUB drawing:
6.  
7. DO
8.     mouseWheel = 0
9.     DO WHILE _MOUSEINPUT
10.         mouseWheel = mouseWheel + _MOUSEWHEEL
11.     LOOP
12.     IF mouseWheel = 1 THEN points = points + 1: CLS: GOSUB drawing
13.     IF mouseWheel = -1 THEN points = points - 1: CLS: GOSUB drawing:
14.     a$ = INKEY$
15.     IF a$ = CHR$(27) THEN END
16. LOOP
17.  
18. drawing:
19. mouseWheel = 0
20. IF points < 1 THEN points = 1
21. IF points > 50 THEN points = 50
22. FOR a = 1 TO 1200 * points STEP 20
23.     seconds = seconds + 5 / points
24.     sec = (60 - seconds) * 6 + 180
25.     x = INT(SIN(sec / 180 * 3.141592) * 180) + 300
26.     y = INT(COS(sec / 180 * 3.141592) * 180) + 300
27.     t = t + 1
28.     xx(t) = x
29.     yy(t) = y
30.     CIRCLE (x, y), 2, _RGB32(255, 255, 255)
31. NEXT a
32. seconds = 0
33.  
34. FOR t2 = 1 TO points * 10
35.     FOR tt = t2 TO (11 + t2) * points STEP t2 * points
36.         IF xx(tt + t2) < 10 OR yy(tt + t2) < 10 THEN GOTO skip:
37.         LINE (xx(tt), yy(tt))-(xx(tt + t2), yy(tt + t2)), _RGB32(255, 255, 255)
38.     NEXT tt
39. NEXT t2
40.  
41. skip:
42. FOR e = 1 TO t
43.     xx(t) = 0
44.     yy(t) = 0
45. NEXT e
46. points$ = STR$(points)
47. _TITLE "Use the mouse wheel (1-50): " + points$
48. t = 0
49. tt = 0
50. _DISPLAY
51. RETURN
52.  

[SierraKen]

I made an auto mode that opens and closes the portal automatically. Pressing Space Bar turns it on and off.
I also made a YouTube video of it:

Here is the code:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(600, 600, 32)
2. DIM xx(5000), yy(5000)
3. _LIMIT 100
4. points = 1
5. dir = 1
6. GOSUB drawing:
7.  
8. DO
9.     mouseWheel = 0
10.     DO WHILE _MOUSEINPUT
11.         mouseWheel = mouseWheel + _MOUSEWHEEL
12.     LOOP
13.     IF mouseWheel = 1 THEN
14.         IF points = 40 THEN GOTO skipthis:
15.         points = points + 1
16.         CLS
17.         GOSUB drawing
18.     END IF
19.     IF mouseWheel = -1 THEN
20.         IF points = 1 THEN GOTO skipthis:
21.         points = points - 1
22.         CLS
23.         GOSUB drawing:
24.     END IF
25.     IF auto / 2 <> INT(auto / 2) THEN
26.         _DELAY .25
27.         IF points = 40 THEN dir = 2
28.         IF points = 1 THEN dir = 1
29.         IF dir = 1 THEN points = points + 1
30.         IF dir = 2 THEN points = points - 1
31.         CLS
32.         GOSUB drawing
33.     END IF
34.  
35.     skipthis:
36.     a$ = INKEY$
37.     IF a$ = CHR$(27) THEN END
38.     IF a$ = " " THEN auto = auto + 1
39. LOOP
40.  
41. drawing:
42. mouseWheel = 0
43. IF points < 1 THEN points = 1
44. IF points > 40 THEN points = 40
45. FOR a = 1 TO 1200 * points STEP 20
46.     seconds = seconds + 5 / points
47.     sec = (60 - seconds) * 6 + 180
48.     x = INT(SIN(sec / 180 * 3.141592) * 180) + 300
49.     y = INT(COS(sec / 180 * 3.141592) * 180) + 300
50.     t = t + 1
51.     xx(t) = x
52.     yy(t) = y
53.     CIRCLE (x, y), 2, _RGB32(255, 255, 255)
54. NEXT a
55. seconds = 0
56.  
57. FOR t2 = 1 TO points * 10
58.     FOR tt = t2 TO (11 + t2) * points STEP t2 * points
59.         IF xx(tt + t2) < 10 OR yy(tt + t2) < 10 THEN GOTO skip:
60.         LINE (xx(tt), yy(tt))-(xx(tt + t2), yy(tt + t2)), _RGB32(255, 255, 255)
61.     NEXT tt
62. NEXT t2
63.  
64. skip:
65. FOR e = 1 TO t
66.     xx(t) = 0
67.     yy(t) = 0
68. NEXT e
69. points$ = STR$(points)
70. _TITLE "Use the mouse wheel (1-40): " + points$ + "   Or press Space Bar for Auto Mode (On/Off)."
71. t = 0
72. tt = 0
73. _DISPLAY
74. RETURN
75.  

[bplus]

@SierraKen

You last posts are reminding me of this done Feb 2019:
https://www.qb64.org/forum/index.php?topic=2931.msg121891#msg121891

[SierraKen]

Here's an even better one than my portal I just made. Instead of a portal, it makes a heart. :)

(Note: I updated this one from about 3 minutes ago when I posted one not as good.)

Here is a different YouTube video showing this one:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(600, 600, 32)
2. DIM xx(10000), yy(10000)
3. _LIMIT 100
4. points = 1
5. dir = 1
6. GOSUB drawing:
7.  
8. DO
9.     mouseWheel = 0
10.     DO WHILE _MOUSEINPUT
11.         mouseWheel = mouseWheel + _MOUSEWHEEL
12.     LOOP
13.     IF mouseWheel = 1 THEN
14.         IF points = 50 THEN GOTO skipthis:
15.         points = points + 1
16.         CLS
17.         GOSUB drawing
18.     END IF
19.     IF mouseWheel = -1 THEN
20.         IF points = 1 THEN GOTO skipthis:
21.         points = points - 1
22.         CLS
23.         GOSUB drawing:
24.     END IF
25.     IF auto / 2 <> INT(auto / 2) THEN
26.         _DELAY .25
27.         IF points = 50 THEN dir = 2
28.         IF points = 1 THEN dir = 1
29.         IF dir = 1 THEN points = points + 1
30.         IF dir = 2 THEN points = points - 1
31.         CLS
32.         GOSUB drawing
33.     END IF
34.  
35.     skipthis:
36.     a$ = INKEY$
37.     IF a$ = CHR$(27) THEN END
38.     IF a$ = " " THEN auto = auto + 1
39. LOOP
40.  
41. drawing:
42. mouseWheel = 0
43. IF points < 1 THEN points = 1
44. IF points > 50 THEN points = 50
45. FOR a = 1 TO 1200 * points STEP 10
46.     seconds = seconds + 5 / points
47.     sec = (60 - seconds) * 6 + 180
48.     x = INT(SIN(sec / 180 * 3.141592) * 180) + 300
49.     y = INT(COS(sec / 180 * 3.141592) * 180) + 300
50.     t = t + 1
51.     xx(t) = x
52.     yy(t) = y
53.     CIRCLE (x, y), 2, _RGB32(255, 255, 255)
54. NEXT a
55. seconds = 0
56.  
57. FOR t2 = 1 TO points * 10
58.     FOR tt = t2 TO (11 + t2) * points STEP t2 * (points * 2)
59.          IF xx(tt * 2) < 10 OR yy(tt * 2) < 10 THEN GOTO skip:
60.         IF xx(tt * 3) < 10 OR yy(tt * 3) < 10 THEN GOTO skip:
61.         LINE (xx(tt * 2), yy(tt * 2))-(xx(tt * 3), yy(tt * 3)), _RGB32(255, 255, 255)
62.     NEXT tt
63. NEXT t2
64.  
65. skip:
66. FOR e = 1 TO t
67.     xx(t) = 0
68.     yy(t) = 0
69. NEXT e
70. points$ = STR$(points)
71. _TITLE "Use the mouse wheel (1-50): " + points$ + "   Or press Space Bar for Auto Mode (On/Off)."
72. t = 0
73. tt = 0
74. _DISPLAY
75. RETURN
76.  

[SierraKen]

Bplus, yours is really awesome too! Amazing how many designs you can make with sine and cosine!