Author Topic: I love basket...  (Read 3373 times)

0 Members and 1 Guest are viewing this topic.

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
I love basket...
« on: January 07, 2020, 09:37:27 am »
Hi Guys
I love basket and I found in an old my notebook this one example program that uses smart colors

Code: QB64: [Select]
  1. ' Terry's Ball Jump With "Rotating" Ball   13-05-16
  2. SCREEN _NEWIMAGE(640, 480, 32) '                                               640x480 32bit screen
  3. _SCREENMOVE _MIDDLE '                                                          center on desktop
  4.  
  5. ' declaration  area ***************************************
  6. CONST pi = 3.14
  7. ' colors constant values
  8. CONST rosso~& = _RGB32(255, 0, 0)
  9. CONST rossoc~& = _RGB32(150, 0, 0)
  10. CONST verde~& = _RGB32(0, 255, 0)
  11. CONST bianco~& = _RGB32(255, 255, 255)
  12. CONST nero~& = _RGB32(0, 0, 0)
  13. CONST arancio~& = _RGB32(255, 150, 0)
  14.  
  15. DIM SHARED b&, bp&, cs& '            sound variables
  16. DIM SHARED suono%, suonoamb%
  17. DIM SHARED inlancio% '
  18. DIM SHARED vel_vel% '
  19. DIM Yvel! '                                                                    vertical velocity
  20. DIM Xvel! '                                                                    horizontal velocity
  21. DIM Yacc! '                                                                    vertical acceleration
  22. DIM x! '                                                                       circle horizontal center point
  23. DIM y! '                                                                       circle vertical center point
  24. DIM TimeElapsed# '                                                             elapsed time between frames
  25. DIM Bounciness! '                                                              amount of bounce in object
  26. DIM LineCount% '                                                               generic counter
  27. DIM sngPentagon!(4), sngPent!(4, 1, 1) '                                       Arrays to define corners of pentagon
  28. REDIM image(GETarraysize&(32, 50, 50, 150, 150)) AS _BYTE
  29. ' inizialization  area  ******************************
  30.  
  31. _TITLE "Basket"
  32. FOR bytN%% = 0 TO 4
  33.     sngPentagon!(bytN%%) = bytN%% * 2 * _PI / 5
  34. NEXT bytN%%
  35. sngTheta! = 0 '                                                                Angle of rotation
  36. x! = 20 '                                                                      x location of object
  37. y! = 459 '                                                                     y location of object
  38.  
  39. prova_test_SND ' file sound are here
  40.  
  41.  
  42. inlancio% = 0
  43. a$ = " "
  44. Yvel! = 0 '                                                                    no vertical velocity to start with
  45. Xvel! = 5 '                                                                    horizontal velocity
  46. Yacc! = 30 '                                                                   30 pixels per second acceleration
  47. TimeElapsed# = TIMER(.001) '                                                   get current timer value
  48. Bounciness! = .9 '                                                             0 = no bounce thru 1 = full bounce
  49.  
  50. ' main   ********************************
  51. guida_help
  52. '  cestino  /basket
  53. cesto_basket 50, 100, 100
  54. GET (50, 50)-(150, 150), image()
  55.  
  56.     ' area gestione logica degli oggetti/ area of logic managing of objects
  57.     _LIMIT 60 '                                                                frames per second
  58.     IF suonoamb% = 1 THEN
  59.         IF _SNDPLAYING(b&) = 0 THEN _SNDPLAY b& ELSE PRINT _SNDPLAYING(b&)
  60.     END IF
  61.     IF inlancio% = 2 THEN
  62.         Yvel! = 2.5 * vel_vel%
  63.         inlancio% = 1 ' la palla sta cadendo  ball is bouncing
  64.         vel_vel% = 0
  65.     END IF
  66.  
  67.     TimeElapsed# = TIMER(.001) - TimeElapsed# '                                get elapsed time
  68.     IF ABS(Yvel!) > 0 THEN '                                                   is there vertical velocity?
  69.         Yvel! = Yvel! - Yacc! * TimeElapsed# '                                 yes, compute new vertical velocity based on time
  70.         y! = y! - Yvel! '                                                      subtract velocity from object vertical center point
  71.     END IF
  72.     TimeElapsed# = TIMER(.001) '                                               get current timer value
  73.     IF y! > 459 THEN '                                                         is object still above base line?
  74.         y! = 459 '                                                             no, force object to base line
  75.         Yvel! = ABS(Yvel! * Bounciness!) '                                     set vertical velocity once again to bounce value
  76.         IF Yvel! < .25 THEN
  77.             Yvel! = 0 '                                        bouncing done, stop vertical motion
  78.             inlancio% = 0
  79.         END IF
  80.         IF suono% = 1 THEN _SNDPLAY cs&
  81.     END IF
  82.     x! = x! + Xvel! '                                                          at horizontal velocity
  83.     IF x! > 619 OR x! < 19 THEN
  84.         Xvel! = -Xvel! '                                                       reverse horizontal direction at screen edge
  85.     END IF
  86.  
  87.  
  88.     ' output grafico  / graphic output
  89.     CLS
  90.     PAINT (1, 1), verde~&, rossoc~& 'sfondo /background
  91.     ' barra velocit… /speed bar
  92.     LINE (2, 480 - (10 * vel_vel%))-(12, 480), rossoc~&, BF
  93.     LINE (6, 480 - (10 * vel_vel%))-(8, 480), rosso~&, BF
  94.     PUT (100, 100), image(), PRESET ' basket_cestino
  95.     FOR bytN%% = 0 TO 4 '                                                      extra code to calculate positions of ball seams
  96.         sngPent!(bytN%%, 0, 0) = 10 * COS(sngPentagon!(bytN%%) + sngTheta!) + x!
  97.         sngPent!(bytN%%, 0, 1) = 10 * SIN(sngPentagon!(bytN%%) + sngTheta!) + y!
  98.         sngPent!(bytN%%, 1, 0) = 20 * COS(sngPentagon!(bytN%%) + sngTheta!) + x!
  99.         sngPent!(bytN%%, 1, 1) = 20 * SIN(sngPentagon!(bytN%%) + sngTheta!) + y!
  100.     NEXT bytN%%
  101.  
  102.     intX% = CINT(x!): intY% = CINT(y!)
  103.     CIRCLE (intX%, intY%), 20, _RGB(255, 255, 0) '                             draw the object at current location
  104.     PAINT (intX%, intY% + 19), _RGB32(255, 255, 0), _RGB32(255, 255, 0)
  105.     CIRCLE (intX%, intY%), 20, _RGB(0, 0, 255) '                               extra code for ball seams
  106.     FOR bytN%% = 0 TO 3
  107.         LINE (sngPent!(bytN%%, 0, 0), sngPent!(bytN%%, 0, 1))-(sngPent!(bytN%% + 1, 0, 0), sngPent!(bytN%% + 1, 0, 1)), _RGB(0, 0, 255)
  108.     NEXT bytN%%
  109.     LINE (sngPent!(4, 0, 0), sngPent!(4, 0, 1))-(sngPent!(0, 0, 0), sngPent!(0, 0, 1)), _RGB(0, 0, 255)
  110.     FOR bytN%% = 0 TO 4
  111.         LINE (sngPent!(bytN%%, 0, 0), sngPent!(bytN%%, 0, 1))-(sngPent!(bytN%%, 1, 0), sngPent!(bytN%%, 1, 1)), _RGB(0, 0, 255)
  112.     NEXT bytN%%
  113.     sngTheta! = sngTheta! + Xvel! / (125 - (55 * ATN(458 - intY%))) '          Rotate Ball Seams - dependent upon X speed and Y height
  114.  
  115.     _DISPLAY '     update screen with results
  116.  
  117.     ' area input utente / user's area input
  118.     Utente_user
  119.  
  120.  
  121.  
  122.  
  123. END 'logical end of program
  124.  
  125. '***********************AREA SUB ****************
  126.  
  127.  
  128.  
  129. SUB cesto_basket (radius%, Xc%, Yc%)
  130. a = 0
  131. ' tabellone con rettangolo di tiro  / tablet with square to throw
  132. LINE (Xc% - radius%, Yc% - radius%)-(Xc% + radius%, Yc% + radius%), nero~&, BF
  133. LINE (Xc% - radius% + 2, Yc% - radius% + 2)-(Xc% + radius% - 2, Yc% + radius% - 2), bianco~&, BF
  134. LINE (Xc% - radius% * 2 / 3, Yc% - radius% * 2 / 3)-(Xc% + radius% * 2 / 3, Yc% + radius% * 1 / 4), nero~&, B
  135. ' rete  / web
  136. b = 0
  137. FOR a = (Xc% - radius% * 2 / 3) TO (Xc% + radius% * 2 / 3) STEP (Xc% / 5)
  138.     LINE (a, Yc% + radius% * 1 / 4)-(a + 10, Yc% + (radius% * 1 / 2)), arancio~&
  139.     LINE (a + 10, Yc% + (radius% * 1 / 4))-(a, Yc% + radius% * 1 / 2), arancio~&
  140.     b = b + 1
  141.     IF b < 4 THEN
  142.         LINE (a + 10, Yc% + radius% * 1 / 2)-(a + (Xc% / 5), Yc% + (radius% * 3 / 4)), arancio~&
  143.         LINE (a + (Xc% / 5), Yc% + (radius% * 1 / 2))-(a + 10, Yc% + radius% * 3 / 4), arancio~&
  144.     END IF
  145.  
  146. ' anello di ferro / ring of iron
  147. CIRCLE (Xc%, Yc% - radius% / 8), radius% * 3 / 4, rossoc~&, 1.1 * pi, 1.9 * pi, 1 / 2
  148. CIRCLE (Xc%, Yc% - radius% / 8), radius% * 3 / 4, rossoc~&, 1.1 * pi, 1.9 * pi, 1 / 3
  149. PAINT (Xc%, Yc% - 2 + radius% * 1 / 4), rosso~&, rossoc~&
  150.  
  151. SUB Utente_user
  152. ' ciclo rafforza input utente   / loop focusing on user's input
  153. a$ = " "
  154.     a$ = UCASE$(INKEY$)
  155.     IF a$ = "T" AND vel_vel% < 10 THEN vel_vel% = vel_vel% + 1
  156.     IF a$ = "R" AND vel_vel% > 0 THEN vel_vel% = vel_vel% - 1
  157.     IF a$ = "L" THEN IF inlancio% = 0 THEN inlancio% = 2
  158.     IF a$ = CHR$(27) THEN END
  159.     IF a$ = "S" THEN suono% = suono% * -1
  160.     IF a$ = "M" THEN
  161.         suonoamb% = suonoamb% * -1
  162.         IF _SNDPLAYING(b&) = -1 THEN _SNDSTOP b&
  163.     END IF
  164. LOOP UNTIL a$ = "" ' it waits that user release key_input
  165.  
  166.  
  167. SUB prova_test_SND
  168. ' sub testing files's being and working
  169. COLOR arancio~&, rosso~&
  170. PRINT "verifing sounds..."
  171. b& = _SNDOPEN("basket.mp3", "sync")
  172. bp& = _SNDOPEN("basketpalla.WAV", "sync")
  173. cs& = _SNDOPEN("colposecco.mp3", "sync")
  174.  
  175. IF b& <> 0 THEN _SNDPLAY b& ELSE BEEP
  176. PRINT "Basket.mp3"; b&
  177. IF bp& <> 0 THEN _SNDPLAY bp& ELSE BEEP
  178. PRINT "basketpalla.wav"; bp&
  179. IF cs& <> 0 THEN _SNDPLAY cs& ELSE BEEP
  180. PRINT "colposecco.mp3"; cs&
  181. ' if files's sound are ok then it sets soundflags variables
  182. suono% = 1
  183. suonoamb% = 1
  184.  
  185. SUB guida_help
  186. COLOR rosso~&, verde~&
  187. LOCATE 1, 7: PRINT "Press T/R to up/down velocity of throw and L to launch"
  188. LOCATE 2, 10: PRINT " S toggles sound  and M toggles background sound"
  189. LOCATE 6, 2: PRINT "Premi T/R per aumentare/ridurre la velocit… di lancio e L per lanciare"
  190. LOCATE 7, 10: PRINT " S interruttore suono e M interruttore suono di sfondo"
  191. LOCATE 22, 25: PRINT " Press any key / Premi un tasto "
  192. COLOR , rosso~&
  193.  
  194.  
  195.  
  196.  
  197.  
  198. FUNCTION GETarraysize& (screenmode&, x1&, y1&, x2&, y2&)
  199. bpp = 1: planes = 4
  200. SELECT CASE screenmode&
  201.     CASE 1
  202.         bpp = 2: planes = 1
  203.     CASE 2, 11
  204.         planes = 1
  205.     CASE 7, 8, 9, 12
  206.     CASE 10
  207.         planes = 2
  208.     CASE 13
  209.         bpp = 8: planes = 1
  210.     CASE 256
  211.         GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) + 3
  212.         EXIT FUNCTION
  213.     CASE 32
  214.         GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) * 4 + 3
  215.         EXIT FUNCTION
  216.     CASE ELSE
  217.         ERROR 5
  218. GETarraysize& = 4 + INT(((x2& - x1& + 1) * bpp + 7) / 8) * planes * (y2& - y1& + 1)
  219.  
  220.  
here attached the code plus the files for sound.
The code uses an algorythm posted by Terry Ritchie that liked to the .net forum so other coders made their MOD.
That's mine,  for now uncomplete.
Quote
Instructions:
Press T/R to up/down velocity of throw and L to launch
 S toggles sound  and M toggles background sound

In this program you can find the FUNCTION GETarraysize& (screenmode&, x1&, y1&, x2&, y2&) developed by me and Bert (so my memory says to me) in the sense that I have tossed an empiric formula for calculation for SCREEN 32 bit to use with GET image() and Bert had corrected my empiric formula to a math precision formula.
Code: QB64: [Select]
  1. FUNCTION GETarraysize& (screenmode&, x1&, y1&, x2&, y2&)
  2. bpp = 1: planes = 4
  3. SELECT CASE screenmode&
  4.     CASE 1
  5.         bpp = 2: planes = 1
  6.     CASE 2, 11
  7.         planes = 1
  8.     CASE 7, 8, 9, 12
  9.     CASE 10
  10.         planes = 2
  11.     CASE 13
  12.         bpp = 8: planes = 1
  13.     CASE 256
  14.         GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) + 3
  15.         EXIT FUNCTION
  16.     CASE 32
  17.         GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) * 4 + 3
  18.         EXIT FUNCTION
  19.     CASE ELSE
  20.         ERROR 5
  21. GETarraysize& = 4 + INT(((x2& - x1& + 1) * bpp + 7) / 8) * planes * (y2& - y1& + 1)
  22.  
PS GET image()  the QB45 keyword is deprecated versus the set of keywords of QB64 more flexible and powerful and automated, but if you are porting an old your code into QB64 you can use this function to correct the dimension of the array used for images and not recode whole your program if you turn it in 32bitmode.

Thanks to read
* basket_rimbalzo.rar (Filesize: 292.89 KB, Downloads: 145)
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: I love basket...
« Reply #1 on: January 16, 2020, 04:14:55 pm »
Hi TempodiBasic,

Do you have .zip or .7z (if not too much trouble)?

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: I love basket...
« Reply #2 on: January 16, 2020, 04:28:58 pm »
Sure Sir
in attachment  a .ZIP made by 7.zip

Errata Corrige the formula for managing the size of array in 32bit  screen mode  has been posted in that old thread by JohnB.
Thanks to read

* basket_rimbalzo.zip (Filesize: 354.91 KB, Downloads: 125)
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: I love basket...
« Reply #3 on: January 16, 2020, 04:30:50 pm »
Got it thank you!