Author Topic: Rain Drain 2  (Read 4044 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

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

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Rain Drain 2
« Reply #1 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.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rain Drain 2
« Reply #2 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 ;-))

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Rain Drain 2
« Reply #3 on: August 29, 2020, 03:29:16 pm »
B+, if you want to make it, go ahead! :)

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: Rain Drain 2
« Reply #4 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.
It works better if you plug it in.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rain Drain 2
« Reply #5 on: August 30, 2020, 01:26:10 pm »
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 :-))
 
Lander at Etna.PNG

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

But those Particle Fountains have nothing on Rain Drain 2:
 
Rain Drain 2.PNG

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

« Last Edit: August 30, 2020, 01:27:52 pm by bplus »

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Rain Drain 2
« Reply #6 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?
Logic is the beginning of wisdom.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Rain Drain 2
« Reply #7 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.
« Last Edit: August 30, 2020, 07:11:48 pm by bplus »

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Rain Drain 2
« Reply #8 on: August 31, 2020, 07:50:27 am »
I brie leave you may be correct. You obviously have gouda taste buds.... lol
Logic is the beginning of wisdom.