Rain Drain 2

[bplus]

Well sure, swing the bars back and forth!

Code: QB64: [Select]

1. 'Rain Drain.bas started 2017-09-13
2. 'translated from
3. 'Rain Drain.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-26
4.  
5. ' 2020-08-29 Rain Drain 2: What if we move one side of every line up and down?
6.  
7. _DEFINE A-Z AS SINGLE
8. RANDOMIZE TIMER
9. CONST xmax = 1100
10. CONST ymax = 700
11.  
12. SCREEN _NEWIMAGE(xmax, ymax, 32)
13. _DELAY .25
14. _SCREENMOVE _MIDDLE
15. _TITLE "Rain Drain 2:   spacebar for new arrangement,    esc to quit"
16.  
17. TYPE ball
18.     x AS SINGLE
19.     y AS SINGLE
20.     speed AS SINGLE
21.     r AS SINGLE
22.     c AS LONG
23. END TYPE
24.  
25. TYPE bLine
26.     x1 AS SINGLE
27.     y1 AS SINGLE
28.     x2 AS SINGLE
29.     y2 AS SINGLE
30.     a AS DOUBLE
31. END TYPE
32.  
33. WHILE 1
34.     balls = 1500
35.     REDIM b(balls) AS ball
36.     FOR i = 1 TO balls
37.         b(i).x = RND * xmax
38.         b(i).y = RND * ymax
39.         b(i).speed = 9.85
40.         b(i).r = 6
41.         b(i).c = _RGB(0, rand%(200, 255), rand%(200, 255))
42.     NEXT
43.  
44.     m = 10
45.     nbl = 12
46.     REDIM bl(nbl) AS bLine
47.     FOR i = 1 TO nbl
48.         d = rand%(50, 200)
49.         bl(i).x1 = rand%(m, xmax - d - m)
50.         bl(i).y1 = i * ymax / nbl - 10
51.         bl(i).a = RND * _PI(1 / 4) - _PI(1 / 8)
52.         bl(i).x2 = bl(i).x1 + d * COS(bl(i).a)
53.         bl(i).y2 = bl(i).y1 + d * SIN(bl(i).a)
54.     NEXT
55.     dir = .5: lp = 0
56.     WHILE 1
57.         CLS
58.         IF 32 = _KEYHIT THEN
59.             EXIT WHILE
60.         ELSEIF 27 = _KEYHIT THEN
61.             END
62.         END IF
63.         lp = lp + dir
64.         IF lp > 50 THEN dir = -dir
65.         IF lp < -50 THEN dir = -dir
66.  
67.         FOR j = 1 TO balls
68.             IF b(j).y - b(j).r > ymax OR b(j).x + b(j).r < 0 OR b(j).x - b(j).r > xmax THEN
69.                 b(j).x = rand%(0, xmax): b(j).y = 0
70.             END IF
71.             fcirc b(j).x, b(j).y, b(j).r, b(j).c
72.             testx = b(j).x + b(j).speed * COS(_PI(.5))
73.             testy = b(j).y + b(j).speed * SIN(_PI(.5))
74.             cFlag = 0
75.             FOR i = 1 TO nbl
76.                 COLOR _RGB(255, 0, 0)
77.                 IF j = 1 THEN bl(i).y1 = bl(i).y1 + dir
78.                 LINE (bl(i).x1, bl(i).y1)-(bl(i).x2, bl(i).y2)
79.                 IF cFlag = 0 THEN
80.                     IF hitLine(testx, testy, b(j).r, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) THEN
81.                         bx1 = b(j).x + b(j).speed * COS(bl(i).a)
82.                         bx2 = b(j).x + b(j).speed * COS(_PI(1) - bl(i).a)
83.                         by1 = yy(bx1, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
84.                         by2 = yy(bx2, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
85.                         IF by1 = (-9999 - b(j).r - 1) OR by2 = (-9999 - b(j).r - 1) THEN
86.                             cFlag = 0: EXIT FOR
87.                         END IF
88.                         IF by1 >= by2 THEN b(j).y = by1: b(j).x = bx1 ELSE b(j).y = by2: b(j).x = bx2
89.                         cFlag = 1
90.                     END IF
91.                 END IF
92.             NEXT
93.             IF cFlag = 0 THEN b(j).x = testx: b(j).y = testy
94.         NEXT
95.         _LIMIT 20
96.         _DISPLAY
97.     WEND
98. WEND
99.  
100. FUNCTION hitLine (x, y, r, xx1, yy1, xx2, yy2)
101.     x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2
102.     IF x1 > x2 THEN SWAP x1, x2: SWAP y1, y2
103.     IF x < x1 OR x > x2 THEN hitLine = 0: EXIT SUB
104.     IF ((y2 - y1) / (x2 - x1)) * (x - x1) + y1 - r < y AND y < ((y2 - y1) / (x2 - x1)) * (x - x1) + y1 + r THEN
105.         hitLine = 1
106.     ELSE
107.         hitLine = 0
108.     END IF
109. END FUNCTION
110.  
111. FUNCTION yy (x, xx1, yy1, xx2, yy2) 'this puts drop on line
112.     'copy parameters that are changed
113.     x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2
114.     IF x1 > x2 THEN SWAP x1, x2: SWAP y1, y2
115.     IF x1 <= x AND x <= x2 THEN
116.         yy = ((y2 - y1) / (x2 - x1)) * (x - x1) + y1
117.     ELSE
118.         yy = -9999
119.     END IF
120. END FUNCTION
121.  
122. FUNCTION rand% (lo%, hi%)
123.     rand% = (RND * (hi% - lo% + 1)) \ 1 + lo%
124. END FUNCTION
125.  
126. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
127.     DIM Radius AS INTEGER, RadiusError AS INTEGER
128.     DIM X AS INTEGER, Y AS INTEGER
129.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
130.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
131.     LINE (CX - X, CY)-(CX + X, CY), C, BF
132.     WHILE X > Y
133.         RadiusError = RadiusError + Y * 2 + 1
134.         IF RadiusError >= 0 THEN
135.             IF X <> Y + 1 THEN
136.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
137.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
138.             END IF
139.             X = X - 1
140.             RadiusError = RadiusError - X * 2
141.         END IF
142.         Y = Y + 1
143.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
144.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
145.     WEND
146. END SUB
147.  
148.  

[SierraKen]

LOL awesome B+. About 10 years ago or so I downloaded a simulation game where it was just like this except there was also different chemicals and fire and explosions. Like you could put a flame anywhere and gas somewhere else and if the gas landed on the flame it would explode. Then you can set it to water and put the fire out. :) I wish I remembered the name of it. Would be pretty cool to remake it, but lots of work so I don't know if I want to.

[bplus]

Great idea Ken!

I must be getting old, I was just thinking about moving the bars independently of one another. Explosions, fires and floods sound so much better ;-))

[SierraKen]

B+, if you want to make it, go ahead! :)

[Richard Frost]

There's a particle fountain in my Moon Lander too - the volcano.  One can jump there with "e" for "Etna".
The lava heats up the ship, blows up the ship if Invincible mode is off (shift-i), and is deflected if shields are on (F8).

Lava is a good source of cheddar cheese.

[bplus]

There's a particle fountain in my Moon Lander too - the volcano.  One can jump there with "e" for "Etna".
The lava heats up the ship, blows up the ship if Invincible mode is off (shift-i), and is deflected if shields are on (F8).

Lava is a good source of cheddar cheese.

Well Particle Fountain was the other thread but I hear Cheddar cheese is good on fried squirrels.

Time for a little spin on the Lander :-))
 

Looks like a reverse particle fountain from the Lander as well!

But those Particle Fountains have nothing on Rain Drain 2:
 

Trust me, the movie is much more interesting than this still shot :)

[johnno56]

Cheddar? On squirrel? Are you serious?! You 'never' use any cheese other than Swiss! Swiss's natural 'nutty' flavour is ideal for squirrel... Cheddar... How could you?

[bplus]

@johnno56  that's just swissful thinking on your part. It's squirrels who need the nuts, your argument is full of holes. Cheddar is the sharp choice.

[johnno56]

I brie leave you may be correct. You obviously have gouda taste buds.... lol