QB64.org Forum

Active Forums => Programs => Topic started by: TerryRitchie on August 21, 2018, 03:16:37 am

Title: Spark Generator
Post by: TerryRitchie on August 21, 2018, 03:16:37 am

Here's a little spark generator I created years ago. Press any key and see some sparks. Hold a key down for spark mania!

Code: QB64: [Select]

1. CONST FALSE = 0, TRUE = NOT FALSE
2.  
3. TYPE SPARK
4.     count AS INTEGER
5.     x AS SINGLE
6.     y AS SINGLE
7.     xdir AS SINGLE
8.     ydir AS SINGLE
9.     speed AS SINGLE
10.     fade AS INTEGER
11. END TYPE
12.  
13. REDIM sparks(0) AS SPARK
14.  
15. SCREEN _NEWIMAGE(1024, 768, 32)
16. CLS
17. _SCREENMOVE _MIDDLE
18. RANDOMIZE TIMER
19.  
20. DO
21.     keypress$ = INKEY$
22.     _LIMIT 32
23.     CLS
24.     IF keypress$ = " " THEN MakeSparks INT(RND(1) * 1024), INT(RND(1) * 768)
25.     UpdateSparks
26.     _DISPLAY
27. LOOP UNTIL keypress$ = CHR$(27)
28. END
29.  
30. '------------------------------
31.  
32. SUB MakeSparks (x%, y%)
33.  
34. SHARED sparks() AS SPARK
35.  
36. DIM cleanup%, count%, topspark%
37.  
38. cleanup% = TRUE
39. FOR count% = 1 TO UBOUND(sparks)
40.     IF sparks(count%).count <> 0 THEN
41.         cleanup% = FALSE
42.         EXIT FOR
43.     END IF
44. NEXT count%
45. IF cleanup% THEN REDIM sparks(0) AS SPARK
46. topspark% = UBOUND(sparks)
47. REDIM _PRESERVE sparks(topspark% + 11) AS SPARK
48. FOR count% = 1 TO 10
49.     sparks(topspark% + count%).count = 32
50.     sparks(topspark% + count%).x = x%
51.     sparks(topspark% + count%).y = y%
52.     sparks(topspark% + count%).fade = 255
53.     sparks(topspark% + count%).speed = INT(RND(1) * 6) + 6
54.     sparks(topspark% + count%).xdir = RND(1) - RND(1)
55.     sparks(topspark% + count%).ydir = RND(1) - RND(1)
56. NEXT count%
57.  
58. END SUB
59.  
60. '--------------------------------------
61.  
62. SUB UpdateSparks ()
63.  
64. SHARED sparks() AS SPARK
65.  
66. DIM count%, fade1%, fade2%
67.  
68. FOR count% = 1 TO UBOUND(sparks)
69.     IF sparks(count%).count > 0 THEN
70.         fade1% = sparks(count%).fade / 2
71.         fade2% = sparks(count%).fade / 4
72.         PSET (sparks(count%).x, sparks(count%).y), _RGB(sparks(count%).fade, sparks(count%).fade, sparks(count%).fade)
73.         PSET (sparks(count%).x + 1, sparks(count%).y), _RGB(fade1%, fade1%, fade1%)
74.         PSET (sparks(count%).x - 1, sparks(count%).y), _RGB(fade1%, fade1%, fade1%)
75.         PSET (sparks(count%).x, sparks(count%).y + 1), _RGB(fade1%, fade1%, fade1%)
76.         PSET (sparks(count%).x, sparks(count%).y - 1), _RGB(fade1%, fade1%, fade1%)
77.         PSET (sparks(count%).x + 1, sparks(count%).y + 1), _RGB(fade2%, fade2%, fade2%)
78.         PSET (sparks(count%).x - 1, sparks(count%).y - 1), _RGB(fade2%, fade2%, fade2%)
79.         PSET (sparks(count%).x - 1, sparks(count%).y + 1), _RGB(fade2%, fade2%, fade2%)
80.         PSET (sparks(count%).x + 1, sparks(count%).y - 1), _RGB(fade2%, fade2%, fade2%)
81.         sparks(count%).fade = sparks(count%).fade - 8
82.         sparks(count%).x = sparks(count%).x + sparks(count%).xdir * sparks(count%).speed
83.         sparks(count%).y = sparks(count%).y + sparks(count%).ydir * sparks(count%).speed
84.         sparks(count%).speed = sparks(count%).speed / 1.1
85.         sparks(count%).count = sparks(count%).count - 1
86.     END IF
87. NEXT count%
88.  
89. END SUB
90.  

Title: Re: Spark Generator
Post by: johnno56 on August 21, 2018, 07:50:01 pm

Cool...

Title: Re: Spark Generator
Post by: FellippeHeitor on August 21, 2018, 08:16:18 pm

Very nice effect indeed, Terry. But by "any key" you mean the space bar, right?

Thanks for sharing!

Title: Re: Spark Generator
Post by: TerryRitchie on August 22, 2018, 12:07:17 am

Quote from: FellippeHeitor on August 21, 2018, 08:16:18 pm

Very nice effect indeed, Terry. But by "any key" you mean the space bar, right?

Thanks for sharing!

Oops, LOL -- Yes

Text Only | Text with Attachments