QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Petr on December 27, 2021, 03:42:50 pm

Title: Happy new year 2022
Post by: Petr on December 27, 2021, 03:42:50 pm

Hi, here is a small post to wish for 2022. I'm too lazy to make better missile synchronization, so I did it the way it is. Basically, the flight speed of the projectile would be solved depending on the length of the trajectory to the target, so that all the projectiles get to their seats at the same time....

Happy new year.

Code: QB64: [Select]

1. Dim Shared START
2.  
3. $Color:32
4. DW = 1980
5. DH = 1050
6.  
7. Type RCK
8.     FlyX As Integer
9.     FlyY As Integer
10.     FlyA As Single
11.     FlyL As Integer
12.     X As Integer
13.     Y As Integer
14.     Radius As Integer
15.     Rad2 As Integer
16.     Arms As Integer
17.     ArmPi As Single
18.     EndRad As Integer
19.     Effect As _Byte
20.     Kolor As _Unsigned Long
21. End Type
22.  
23. ReDim Shared RCK(0) As RCK
24.  
25.  
26. Dim Shared As Long V
27. V& = _NewImage(DW, DH, 32)
28.  
29.  
30.  
31.  
32.  
33.  
34. Screen _NewImage(DW, DH, 32)
35. _FullScreen _SquarePixels
36. T = Timer
37. Dim rrr(376)
38. ef = 2
39. For rrrL = 1 To 376
40.     If rrrL Mod 50 = 0 Then ef = ef + 1
41.     If ef > 3 Then ef = 2
42.     Read cX, Cy
43.     rrr(rrrL) = NewRocket(cX, Cy, 1 + Int(Rnd * 6), 1 + Rnd * 5, ef, .3)
44. Next
45. Do
46.     For S = 1 To 376
47.         Rocket S
48.     Next
49.  
50.     If Timer - T > 5 Then
51.         T = Timer
52.         START = 0
53.         For S = 1 To 376
54.             ResetRocket S
55.         Next
56.     End If
57.  
58.  
59.     _Display
60.     _Limit 20
61.     Cls
62. Loop
63.  
64. Function NewRocket (X, Y, Arms, EndRadius, Effect, Angle)
65.     U = UBound(RCK)
66.     RCK(U).FlyX = 1 + Rnd * _Width
67.     RCK(U).FlyY = Rnd * 30 + _Height
68.     RCK(U).X = X
69.     RCK(U).Y = Y
70.     RCK(U).Radius = 0
71.     RCK(U).Rad2 = 0
72.     RCK(U).Arms = Arms
73.     RCK(U).ArmPi = Angle
74.     RCK(U).EndRad = EndRadius
75.     RCK(U).Effect = Effect
76.     RCK(U).Kolor = _RGB32(255 * Rnd, 200 * Rnd, 95 * Rnd)
77.     RCK(U).FlyA = _Atan2(RCK(U).FlyY - Y, RCK(U).FlyX - X)
78.     RCK(U).FlyL = _Hypot(Y - RCK(U).FlyY, X - RCK(U).FlyX)
79.     NewRocket = U
80.     ReDim _Preserve RCK(U + 1) As RCK
81. End Function
82.  
83. Sub ResetRocket (U)
84.     If START Then Exit Sub
85.     RCK(U).FlyX = 1 + Rnd * _Width
86.     RCK(U).FlyY = Rnd * 30 + _Height
87.     RCK(U).Radius = 0
88.     RCK(U).Rad2 = 0
89.     RCK(U).Kolor = _RGB32(255 * Rnd, 200 * Rnd, 95 * Rnd)
90.     RCK(U).FlyA = _Atan2(RCK(U).FlyY - RCK(U).Y, RCK(U).FlyX - RCK(U).X)
91.     RCK(U).FlyL = _Hypot(RCK(U).Y - RCK(U).FlyY, RCK(U).X - RCK(U).FlyX)
92. End Sub
93.  
94.  
95. Sub Rocket (Handle)
96.     START = 0
97.     Speed = 30
98.     If RCK(Handle).FlyL > 0 Then
99.         START = 1
100.         RCK(Handle).FlyL = RCK(Handle).FlyL - Speed
101.  
102.         DX = RCK(Handle).X + Cos(RCK(Handle).FlyA) * RCK(Handle).FlyL
103.         DY = RCK(Handle).Y + Sin(RCK(Handle).FlyA) * RCK(Handle).FlyL
104.  
105.         DX2 = RCK(Handle).X + Cos(RCK(Handle).FlyA) * (RCK(Handle).FlyL + 20)
106.         DY2 = RCK(Handle).Y + Sin(RCK(Handle).FlyA) * (RCK(Handle).FlyL + 20)
107.  
108.         Line (DX, DY)-(DX2, DY2), White
109.  
110.     Else
111.  
112.         START = 1
113.         Select Case RCK(Handle).Effect
114.             Case 0, 1
115.                 If RCK(Handle).EndRad > RCK(Handle).Radius Then
116.                     R = _Red32(RCK(Handle).Kolor)
117.                     G = _Green32(RCK(Handle).Kolor)
118.                     B = _Blue32(RCK(Handle).Kolor)
119.                     steps = (RCK(Handle).EndRad - RCK(Handle).Radius) + 1
120.                     a = 255 / ((RCK(Handle).EndRad - RCK(Handle).Radius) / 100)
121.  
122.                     If RCK(Handle).Effect = 1 Then
123.                         If RCK(Handle).Radius > 10 Then
124.                             CircleFill RCK(Handle).X, RCK(Handle).Y, RCK(Handle).Radius, _RGBA32(R, G, B, a)
125.                             CircleFill RCK(Handle).X, RCK(Handle).Y, RCK(Handle).Radius - 10, _RGB32(0)
126.                         Else
127.                             CircleFill RCK(Handle).X, RCK(Handle).Y, RCK(Handle).Radius, _RGBA32(R, G, B, a)
128.                         End If
129.                     Else
130.                         CircleFill RCK(Handle).X, RCK(Handle).Y, RCK(Handle).Radius, _RGBA32(R, G, B, a)
131.                     End If
132.  
133.                     RCK(Handle).Radius = RCK(Handle).Radius + 2
134.  
135.                 Else
136.                     ResetRocket Handle
137.                 End If
138.  
139.             Case 2, 3
140.                 If RCK(Handle).Effect = 3 Then RCK(Handle).ArmPi = RCK(Handle).ArmPi + .01
141.                 If RCK(Handle).EndRad > RCK(Handle).Radius Then
142.                     a = _Pi(2) / RCK(Handle).Arms
143.                     d = 0
144.                     Do Until e = RCK(Handle).Arms
145.  
146.                         CircleFill RCK(Handle).X + Cos(d + RCK(Handle).ArmPi) * RCK(Handle).Radius, RCK(Handle).Y + Sin(d + RCK(Handle).ArmPi) * RCK(Handle).Radius, 2, White
147.                         d = d + a
148.                         e = e + 1
149.                     Loop
150.                     RCK(Handle).Radius = RCK(Handle).Radius + 1
151.                     RCK(Handle).Rad2 = RCK(Handle).Radius
152.                 Else
153.                     If RCK(Handle).Rad2 - RCK(Handle).Radius < 22 Then
154.                         a = _Pi(2) / RCK(Handle).Arms
155.                         d = 0: e = 0
156.                         Do Until e = RCK(Handle).Arms
157.                             CircleFill RCK(Handle).X + Cos(d + RCK(Handle).ArmPi) * RCK(Handle).Rad2, RCK(Handle).Y + Sin(d + RCK(Handle).ArmPi) * RCK(Handle).Rad2, 5, RCK(Handle).Kolor Or Black
158.                             d = d + a
159.                             e = e + 1
160.                         Loop
161.                         RCK(Handle).Rad2 = RCK(Handle).Rad2 + 1
162.                     Else
163.                         ResetRocket Handle
164.                     End If
165.                 End If
166.         End Select
167.     End If
168. End Sub
169.  
170.  
171. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
172.     ' CX = center x coordinate
173.     ' CY = center y coordinate
174.     '  R = radius
175.     '  C = fill color
176.     Dim Radius As Integer, RadiusError As Integer
177.     Dim X As Integer, Y As Integer
178.     Radius = Abs(R)
179.     RadiusError = -Radius
180.     X = Radius
181.     Y = 0
182.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
183.     Line (CX - X, CY)-(CX + X, CY), C, BF
184.     While X > Y
185.         RadiusError = RadiusError + Y * 2 + 1
186.         If RadiusError >= 0 Then
187.             If X <> Y + 1 Then
188.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
189.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
190.             End If
191.             X = X - 1
192.             RadiusError = RadiusError - X * 2
193.         End If
194.         Y = Y + 1
195.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
196.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
197.     Wend
198. End Sub
199.  
200.  
201. Data 44,3,47,24,43,53,44,80,44,103,43,130,43,154,43,182,43,205,43,226,63,111,83,115,109,115,130,112,146,111,167,113,193,113,194,0,197,30,193,57,188,91,190,113,186,134,185,159,184,184,182,212,185,229,193,73,267,239,270,218,273,196,273
202. Data 171,275,144,276,121,274,101,281,70,283,42,296,24,315,15,347,15,360,31,380,64,383,94,383,115,383,148,383,174,383,201,383,222,384,242,369,138,345,139,326,136,309,137,291,137,431,243,435,218,431,195,432,169,434,143,433,112,433,88
203. Data 433,61,433,39,432,17,453,6,477,9,497,14,519,19,537,28,541,55,538,71,530,87,513,104,490,116,464,122,448,124,598,256,596,239,591,204,593,220,593,178,593,153,591,117,588,132,590,90,589,62,585,36,591,10,628,10,612,7,652,12,669,17,690
204. Data 30,697,47,694,68,687,85,672,100,654,108,633,122,615,131,600,131,727,5,734,28,739,54,744,65,748,81,752,97,761,116,768,131,778,139,794,132,801,120,812,102,821,85,828,67,831,43,834,25,839,8,783,149,783,166,782,185,783,202,778,232,780
205. Data 253,780,263,1055,268,1050,244,1049,225,1048,201,1047,178,1044,152,1041,124,1040,99,1037,68,1031,40,1041,21,1064,15,1081,31,1089,59,1095,83,1101,104,1107,122,1113,148,1118,169,1123,196,1126,217,1131,245,1143,262,1156,270,1158,247,1160
206. Data 217,1157,178,1156,143,1156,125,1156,104,1155,75,1152,43,1153,26,1158,159,1159,196,1317,6,1291,8,1276,11,1253,12,1231,12,1215,18,1211,45,1214,80,1216,102,1216,127,1217,153,1219,182,1220,211,1220,238,1218,265,1230,274,1253,275,1280,273
207. Data 1308,271,1330,270,1347,267,1236,145,1255,144,1283,144,1391,9,1393,25,1397,48,1401,69,1403,91,1408,116,1410,137,1414,154,1418,173,1422,190,1425,206,1429,232,1439,254,1446,269,1464,273,1481,258,1490,236,1500,223,1511,194,1521,165,1530
208. Data 144,1545,119,1555,97,1563,70,1572,43,1576,13,1492,8,1502,35,1515,60,1523,88,1527,104,1528,123,1540,157,1552,189,1560,210,1577,231,1578,255,1587,279,1595,295,1617,302,1622,281,1628,261,1637,233,1642,212,1642,186,1647,158,1655,135
209. Data 1658,115,1662,91,1665,64,1668,36,1669,19,1675,1,452,477,456,496,466,521,473,544,485,570,495,591,510,613,520,629,537,633,555,621,570,601,588,578,598,563,616,539,624,515,631,494,641,469,534,654,531,671,530,695,532,722,531,744,536,773
210. Data 534,795,528,824,865,476,846,477,819,474,794,473,771,471,758,472,731,472,718,474,706,493,710,519,708,555,706,584,701,602,700,625,702,654,704,673,702,699,701,722,701,744,701,768,700,790,698,816,711,832,745,839,764,839,794,837,812,838
211. Data 843,841,862,842,717,658,749,666,777,665,796,665,825,665,923,849,930,813,924,826,933,786,941,754,944,731,950,701,958,668,962,648,967,625,977,594,982,562,982,522,986,540,993,493,1013,486,1032,510,1040,532,1050,561,1056,579,1062,599,1070
212. Data 626,1080,655,1093,680,1096,708,1109,734,1115,756,1124,778,1132,809,1143,835,1151,857,1076,697,1054,697,1033,698,1008,694,978,690,958,688,1199,858,1199,833,1199,804,1197,775,1196,751,1194,717,1191,690,1188,668,1188,634,1183,608,1180
213. Data 583,1180,562,1179,535,1176,503,1197,492,1217,491,1243,491,1266,490,1284,492,1308,504,1325,517,1339,544,1341,564,1341,589,1333,617,1314,633,1301,641,1281,644,1258,651,1231,650,1209,654,1214,673,1234,701,1254,718,1273,737,1289,759,1297
214. Data 770,1313,787,1322,797,1332,811,1351,824,1359,839,1375,853
215.  
216.  

Title: Re: Happy new year 2022
Post by: bplus on December 27, 2021, 04:04:19 pm

Nice, Happy New Year Petr!

Title: Re: Happy new year 2022
Post by: johnno56 on December 27, 2021, 04:35:01 pm

Cool...

DIS chu' DatIvjaj (Klingon - Happy new year) Sorry... There does not seem to be a good translation for 'happy'

Text Only | Text with Attachments