Hi Guys
I love basket and I found in an old my notebook this one example program that uses smart colors
' Terry's Ball Jump With "Rotating" Ball 13-05-16
' declaration area ***************************************
' colors constant values
DIM Yvel!
' vertical velocity DIM Xvel!
' horizontal velocity DIM Yacc!
' vertical acceleration DIM x!
' circle horizontal center point DIM y!
' circle vertical center point DIM TimeElapsed#
' elapsed time between frames DIM Bounciness!
' amount of bounce in object DIM LineCount%
' generic counter DIM sngPentagon!
(4), sngPent!
(4, 1, 1) ' Arrays to define corners of pentagon ' inizialization area ******************************
sngPentagon!
(bytN%%
) = bytN%%
* 2 * _PI / 5sngTheta! = 0 ' Angle of rotation
x! = 20 ' x location of object
y! = 459 ' y location of object
prova_test_SND ' file sound are here
inlancio% = 0
a$ = " "
Yvel! = 0 ' no vertical velocity to start with
Xvel! = 5 ' horizontal velocity
Yacc! = 30 ' 30 pixels per second acceleration
TimeElapsed#
= TIMER(.001) ' get current timer valueBounciness! = .9 ' 0 = no bounce thru 1 = full bounce
' main ********************************
guida_help
' cestino /basket
cesto_basket 50, 100, 100
GET (50, 50)-(150, 150), image
()
' area gestione logica degli oggetti/ area of logic managing of objects
Yvel! = 2.5 * vel_vel%
inlancio% = 1 ' la palla sta cadendo ball is bouncing
vel_vel% = 0
TimeElapsed#
= TIMER(.001) - TimeElapsed#
' get elapsed time IF ABS(Yvel!
) > 0 THEN ' is there vertical velocity? Yvel! = Yvel! - Yacc! * TimeElapsed# ' yes, compute new vertical velocity based on time
y! = y! - Yvel! ' subtract velocity from object vertical center point
TimeElapsed#
= TIMER(.001) ' get current timer value IF y!
> 459 THEN ' is object still above base line? y! = 459 ' no, force object to base line
Yvel!
= ABS(Yvel!
* Bounciness!
) ' set vertical velocity once again to bounce value Yvel! = 0 ' bouncing done, stop vertical motion
inlancio% = 0
x! = x! + Xvel! ' at horizontal velocity
Xvel! = -Xvel! ' reverse horizontal direction at screen edge
' output grafico / graphic output
PAINT (1, 1), verde~&
, rossoc~&
'sfondo /background ' barra velocit… /speed bar
LINE (2, 480 - (10 * vel_vel%
))-(12, 480), rossoc~&
, BF
LINE (6, 480 - (10 * vel_vel%
))-(8, 480), rosso~&
, BF
PUT (100, 100), image
(), PRESET ' basket_cestino FOR bytN%%
= 0 TO 4 ' extra code to calculate positions of ball seams sngPent!
(bytN%%
, 0, 0) = 10 * COS(sngPentagon!
(bytN%%
) + sngTheta!
) + x!
sngPent!
(bytN%%
, 0, 1) = 10 * SIN(sngPentagon!
(bytN%%
) + sngTheta!
) + y!
sngPent!
(bytN%%
, 1, 0) = 20 * COS(sngPentagon!
(bytN%%
) + sngTheta!
) + x!
sngPent!
(bytN%%
, 1, 1) = 20 * SIN(sngPentagon!
(bytN%%
) + sngTheta!
) + y!
CIRCLE (intX%
, intY%
), 20, _RGB(255, 255, 0) ' draw the object at current location CIRCLE (intX%
, intY%
), 20, _RGB(0, 0, 255) ' extra code for ball seams LINE (sngPent!
(bytN%%
, 0, 0), sngPent!
(bytN%%
, 0, 1))-(sngPent!
(bytN%%
+ 1, 0, 0), sngPent!
(bytN%%
+ 1, 0, 1)), _RGB(0, 0, 255) LINE (sngPent!
(4, 0, 0), sngPent!
(4, 0, 1))-(sngPent!
(0, 0, 0), sngPent!
(0, 0, 1)), _RGB(0, 0, 255) LINE (sngPent!
(bytN%%
, 0, 0), sngPent!
(bytN%%
, 0, 1))-(sngPent!
(bytN%%
, 1, 0), sngPent!
(bytN%%
, 1, 1)), _RGB(0, 0, 255) sngTheta!
= sngTheta!
+ Xvel!
/ (125 - (55 * ATN(458 - intY%
))) ' Rotate Ball Seams - dependent upon X speed and Y height
' area input utente / user's area input
Utente_user
END 'logical end of program
'***********************AREA SUB ****************
SUB cesto_basket
(radius%
, Xc%
, Yc%
) a = 0
' tabellone con rettangolo di tiro / tablet with square to throw
LINE (Xc%
- radius%
, Yc%
- radius%
)-(Xc%
+ radius%
, Yc%
+ radius%
), nero~&
, BF
LINE (Xc%
- radius%
+ 2, Yc%
- radius%
+ 2)-(Xc%
+ radius%
- 2, Yc%
+ radius%
- 2), bianco~&
, BF
LINE (Xc%
- radius%
* 2 / 3, Yc%
- radius%
* 2 / 3)-(Xc%
+ radius%
* 2 / 3, Yc%
+ radius%
* 1 / 4), nero~&
, B
' rete / web
b = 0
FOR a
= (Xc%
- radius%
* 2 / 3) TO (Xc%
+ radius%
* 2 / 3) STEP (Xc%
/ 5) LINE (a
, Yc%
+ radius%
* 1 / 4)-(a
+ 10, Yc%
+ (radius%
* 1 / 2)), arancio~&
LINE (a
+ 10, Yc%
+ (radius%
* 1 / 4))-(a
, Yc%
+ radius%
* 1 / 2), arancio~&
b = b + 1
LINE (a
+ 10, Yc%
+ radius%
* 1 / 2)-(a
+ (Xc%
/ 5), Yc%
+ (radius%
* 3 / 4)), arancio~&
LINE (a
+ (Xc%
/ 5), Yc%
+ (radius%
* 1 / 2))-(a
+ 10, Yc%
+ radius%
* 3 / 4), arancio~&
' anello di ferro / ring of iron
CIRCLE (Xc%
, Yc%
- radius%
/ 8), radius%
* 3 / 4, rossoc~&
, 1.1 * pi
, 1.9 * pi
, 1 / 2 CIRCLE (Xc%
, Yc%
- radius%
/ 8), radius%
* 3 / 4, rossoc~&
, 1.1 * pi
, 1.9 * pi
, 1 / 3 PAINT (Xc%
, Yc%
- 2 + radius%
* 1 / 4), rosso~&
, rossoc~&
' ciclo rafforza input utente / loop focusing on user's input
a$ = " "
IF a$
= "T" AND vel_vel%
< 10 THEN vel_vel%
= vel_vel%
+ 1 IF a$
= "R" AND vel_vel%
> 0 THEN vel_vel%
= vel_vel%
- 1 IF a$
= "S" THEN suono%
= suono%
* -1 suonoamb% = suonoamb% * -1
LOOP UNTIL a$
= "" ' it waits that user release key_input
' sub testing files's being and working
PRINT "verifing sounds..." bp&
= _SNDOPEN("basketpalla.WAV", "sync")cs&
= _SNDOPEN("colposecco.mp3", "sync")
PRINT "basketpalla.wav"; bp&
PRINT "colposecco.mp3"; cs&
' if files's sound are ok then it sets soundflags variables
suono% = 1
suonoamb% = 1
LOCATE 1, 7:
PRINT "Press T/R to up/down velocity of throw and L to launch" LOCATE 2, 10:
PRINT " S toggles sound and M toggles background sound" LOCATE 6, 2:
PRINT "Premi T/R per aumentare/ridurre la velocit… di lancio e L per lanciare" LOCATE 7, 10:
PRINT " S interruttore suono e M interruttore suono di sfondo" LOCATE 22, 25:
PRINT " Press any key / Premi un tasto "
FUNCTION GETarraysize&
(screenmode&
, x1&
, y1&
, x2&
, y2&
) bpp = 1: planes = 4
bpp = 2: planes = 1
planes = 1
planes = 2
bpp = 8: planes = 1
GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) + 3
GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) * 4 + 3
GETarraysize&
= 4 + INT(((x2&
- x1&
+ 1) * bpp
+ 7) / 8) * planes
* (y2&
- y1&
+ 1)
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.
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.
FUNCTION GETarraysize&
(screenmode&
, x1&
, y1&
, x2&
, y2&
) bpp = 1: planes = 4
bpp = 2: planes = 1
planes = 1
planes = 2
bpp = 8: planes = 1
GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) + 3
GETarraysize& = (x2& - x1& + 1) * (y2& - y1& + 1) * 4 + 3
GETarraysize&
= 4 + INT(((x2&
- x1&
+ 1) * bpp
+ 7) / 8) * planes
* (y2&
- y1&
+ 1)
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