Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on January 08, 2019, 04:31:09 pm

Title: Boing
Post by: bplus on January 08, 2019, 04:31:09 pm
Code: QB64: [Select]
  1. _TITLE "Mouse down, drag ball, release...  Boing" 'B+ 2019-01-08 from
  2. 'boing.bas for SmallBASIC 2015-07-25 MGA/B+
  3. 'coloring mods
  4.  
  5. CONST xmax = 1200
  6. CONST ymax = 700
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  9.  
  10. DIM s(1 TO 4, 1 TO 2)
  11. s(1, 1) = 0: s(1, 2) = 50
  12. s(2, 1) = 0: s(2, 2) = ymax - 50
  13. s(3, 1) = xmax + 30: s(3, 2) = 50
  14. s(4, 1) = xmax + 30: s(4, 2) = ymax - 50
  15. oldtx = 0: oldtyty = 0: da = .03
  16. boingx = 0: boingy = 0
  19.     mb = _MOUSEBUTTON(1)
  20.     IF mb THEN
  21.         tx = _MOUSEX + 20
  22.         ty = _MOUSEY
  23.     ELSE
  24.         tx = xmax / 2
  25.         ty = ymax / 2
  26.         IF tx <> oldtx OR ty <> oldty THEN
  27.             boingx = 3 * (tx - oldtx) / 4
  28.             boingy = 3 * (ty - oldty) / 4
  29.         ELSE
  30.             boingx = -3 * boingx / 4
  31.             boingy = -3 * boingy / 4
  32.         END IF
  33.         tx = tx + boingx
  34.         ty = ty + boingy
  35.     END IF
  36.     a = 0
  37.     oldtx = tx
  38.     oldty = ty
  39.     CLS
  40.     FOR corner = 1 TO 4
  41.         s1x = s(corner, 1)
  42.         s1y = s(corner, 2)
  43.         dx = (tx - s1x) / 2000
  44.         dy = (ty - s1y) / 2000
  45.         x = tx - 20
  46.         y = ty
  47.         FOR i = 1 TO 2000
  48.             sx = 20 * COS(a) + x
  49.             sy = 20 * SIN(a) + y
  50.             LINE (sx, sy + 5)-(sx + 4, sy + 5), _RGB32(118, 118, 118), BF
  51.             LINE (sx, sy + 4)-(sx + 4, sy + 4), _RGB32(148, 148, 148), BF
  52.             LINE (sx, sy + 3)-(sx + 4, sy + 3), _RGB32(238, 238, 238), BF
  53.             LINE (sx, sy + 2)-(sx + 4, sy + 3), _RGB32(208, 208, 208), BF
  54.             LINE (sx, sy + 1)-(sx + 4, sy + 1), _RGB32(168, 168, 168), BF
  55.             LINE (sx, sy)-(sx + 4, sy), _RGB32(108, 108, 108), BF
  56.             LINE (sx, sy - 1)-(sx + 4, sy - 1), _RGB32(68, 68, 68), BF
  57.             x = x - dx: y = y - dy
  58.             a = a + da
  59.         NEXT
  60.     NEXT
  61.     FOR r = 50 TO 1 STEP -1
  62.         g = (50 - r) * 5 + 5
  63.         COLOR _RGB32(g, g, g)
  64.         fcirc tx - 20, ty, r
  65.     NEXT
  66.     _DISPLAY
  67.     _LIMIT 15
  69.  
  70. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  71. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  72.     DIM subRadius AS LONG, RadiusError AS LONG
  73.     DIM X AS LONG, Y AS LONG
  74.  
  75.     subRadius = ABS(R)
  76.     RadiusError = -subRadius
  77.     X = subRadius
  78.     Y = 0
  79.  
  80.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  81.  
  82.     ' Draw the middle span here so we don't draw it twice in the main loop,
  83.     ' which would be a problem with blending turned on.
  84.     LINE (CX - X, CY)-(CX + X, CY), , BF
  85.  
  86.     WHILE X > Y
  87.         RadiusError = RadiusError + Y * 2 + 1
  88.         IF RadiusError >= 0 THEN
  89.             IF X <> Y + 1 THEN
  90.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  91.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  92.             END IF
  93.             X = X - 1
  94.             RadiusError = RadiusError - X * 2
  95.         END IF
  96.         Y = Y + 1
  97.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  98.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  99.     WEND
  101.  
Title: Re: Boing
Post by: Petr on January 08, 2019, 05:19:48 pm
Very nice, Bplus! Very good idea, to do something as this!
Title: Re: Boing
Post by: Pete on January 08, 2019, 09:41:06 pm
Like I told the kangaroo, just hop, you don't have to go say, boing! boing! boing!

That was cool!

Pete
Title: Re: Boing
Post by: Ashish on January 09, 2019, 05:35:51 am
Perfect bplus! The physics looks good. What are concepts behind rendering that spring?
Title: Re: Boing
Post by: FellippeHeitor on January 09, 2019, 11:14:24 am
Very impressive work, bplus. If I had seen a screenshot first I'd never have believed you weren't using external images for this.
Title: Re: Boing
Post by: bplus on January 09, 2019, 11:25:57 am
Thanks guys!

Ashish, The physics is just math, take 3/4's last bounce for next bounce.
Title: Re: Boing
Post by: TempodiBasic on January 09, 2019, 05:41:55 pm
Great job  Bplus

that ball is unbreakable!
As I move it by leftclick of mouse so I hear the metallic sound of the 4 cords. :-)
Title: Re: Boing
Post by: Pete on January 09, 2019, 06:30:31 pm
Hmmm, I just realized, another program by Mark involving balls. Me, I make AI programs to organize files I download. After three previous downloads, it renamed the folder as, "Mark's Balls" and for some odd reason, my antivirus program keeps scanning it.

I'd love to know that 3/4 effect is for real. It certainly seems like a realistic situation, but I would think the math should be based on some form of geometric progression? Oh well, where's Bill when we need him?

Pete :D

Title: Re: Boing
Post by: Cobalt on January 09, 2019, 07:25:53 pm
Really neat, I can't help but think that if you just click on the ball in the center it would be like punching it, and have it 'shrink away' and then come boinging back forward! split the R and B colors a few pixels as it gets bigger and pop on your old-skool 3d glasses for a show!
Text Only | Text with Attachments