Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on August 29, 2020, 08:24:24 am

Title: Rain Drain 2
Post by: bplus on August 29, 2020, 08:24:24 am
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.  
  9. CONST xmax = 1100
  10. CONST ymax = 700
  11.  
  12. SCREEN _NEWIMAGE(xmax, ymax, 32)
  13. _DELAY .25
  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
  24.  
  25. TYPE bLine
  26.     x1 AS SINGLE
  27.     y1 AS SINGLE
  28.     x2 AS SINGLE
  29.     y2 AS SINGLE
  30.     a AS DOUBLE
  32.  
  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
  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
  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
  121.  
  122. FUNCTION rand% (lo%, hi%)
  123.     rand% = (RND * (hi% - lo% + 1)) \ 1 + lo%
  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
  147.  
  148.  
Title: Re: Rain Drain 2
Post by: SierraKen on August 29, 2020, 02:15:59 pm
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.
Title: Re: Rain Drain 2
Post by: bplus on August 29, 2020, 03:06:40 pm
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 ;-))
Title: Re: Rain Drain 2
Post by: SierraKen on August 29, 2020, 03:29:16 pm
B+, if you want to make it, go ahead! :)
Title: Re: Rain Drain 2
Post by: Richard Frost on August 30, 2020, 02:23:05 am
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.
Title: Re: Rain Drain 2
Post by: bplus on August 30, 2020, 01:26:10 pm
Quote from: Richard Frost on August 30, 2020, 02:23:05 am
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 :)

Title: Re: Rain Drain 2
Post by: johnno56 on August 30, 2020, 05:34:54 pm
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?
Title: Re: Rain Drain 2
Post by: bplus on August 30, 2020, 07:10:33 pm
@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.
Title: Re: Rain Drain 2
Post by: johnno56 on August 31, 2020, 07:50:27 am
I brie leave you may be correct. You obviously have gouda taste buds.... lol
Text Only | Text with Attachments