April 18, 2025, 05:34:02 pm
Welcome,
Guest
. Please
login
or
register
.
Did you miss your
activation email?
1 Hour
1 Day
Forever
Login with username, password and session length
News
: Want to see a specific Tutorial? ASK!
Home
Help
Search
Arcade
Links
Staff List
Login
Register
Bouncing ball
Weekly Qbasic and Qb64 Lesson Topics
>
Forum
>
QB64 lessons and tutorials,Games
>
Games
>
Bouncing ball
Pages: [
1
]
« previous
next »
Print
Author
Topic: Bouncing ball (Read 806 times)
Dustie Bear
Full Member
Posts: 115
Bouncing ball
«
on:
March 25, 2011, 05:20:55 pm »
Hi
Several years ago I wrote a program similar to this one on my old Tandy
color computer , When the ball stopped bouncing and rolling around
a little man would go get the ball and throw it again. He would shoot
at a basket, the ball would be thrown randomly so he
didnt always make the basket. He would do this all day if you didnt stop
the program.
Finaly I got a tape recorder to save my programs on, before that
I had to copy the screen and write the programs on paper and pencil.
If I wanted to run a program again I had to key it in from what I saved
on paper. Longer programs got kinda tiresome. lol
I dont recall having to use this many vars to make the ball bounce
but then thats been many moons ago. That little program nearly
filled the entire memory of that computer.
I dont have the little man in this program and there is no
scientific reasoning for the variables I used.
Although this is not written with real world gravity etc.
its fun to mess with changing values etc. you can make it
do several things that don't happen in the real world.
The rocket in my Lunar Lander uses similar effects to act simulate
gravity.
I thought maybe someone might like messing with this
improving upon it, or use ideas in a game.
Maybe draw a little guy who goes and gets the ball after it stops
moving and throw it again or even catch it as it comes towards him.
Code:
Ball& = _NEWIMAGE(640, 480, 32)
SCREEN Ball&
CONST Left = 1
CONST right = -1
CONST YDecay = 1.8
CONST Drag = .03
CONST Gravity = .5
DIM SHARED Direction
Direction = 1
DIM SHARED XMotion
XMotion = 8
DIM SHARED x
x = 20
DIM SHARED y
y = 0
DIM SHARED Drop
Drop = 0
LINE (0, 200)-(639, 480), _RGB(0, 200, 0), BF
DO
_LIMIT 40
CIRCLE (x, y), 10, _RGB(0, 0, 0)
PAINT (x, y), _RGB(0, 0, 0)
Roll
Fall
CIRCLE (x, y), 10, _RGB(255, 0, 0)
PAINT (x, y), _RGB(255, 0, 0)
_DISPLAY
LOOP UNTIL INKEY$ = "q"
SYSTEM
'--------------------------------------------
SUB Fall
Drop = Drop + Gravity: y = y + Drop
IF y > 189 THEN y = 189: Drop = -Drop: Drop = Drop + YDecay
END SUB
'--------------------------------------------
SUB Roll
' --------- ball hit right wall so bounce back
IF x > 630 THEN x = 630: Direction = -1
IF Direction = right THEN x = x - XMotion: XMotion = XMotion - Drag
' --------- ball hit left wall so bounce back
IF x < 5 THEN x = 5: Direction = 1
IF Direction = Left THEN x = x + XMotion: XMotion = XMotion - Drag
' --------- Ball stopped so throw ball again randomly
IF XMotion < 0 AND y = 189 THEN
XMotion = INT(RND * 6) + 4
y = INT(RND * 80) + 20
Drop = INT(RND * 8) + 1
Drop = -Drop
_DELAY .5 ' ----- Just to put a little pause before the ball gets throw again.
END IF
END SUB
«
Last Edit: March 26, 2011, 08:48:31 am by Dustie Bear
»
Report Spam
Logged
GarrisonRicketson
Admin
Administrator
Hero Member
Posts: 583
Re: Bouncing ball
«
Reply #1
on:
September 06, 2011, 10:01:09 pm »
I had copied this code from some where, and saved it, it has a paddle and a moveing ball, but the paddle dose not move,..I don't know who wrote the original code,..I added a few lines,..and tried changeing some things,..but still could not get the paddle moveing.
Code:
REM
DEFINT A-Z
DIM Ball%(540)
DIM Mask%(540)
DIM Background%(540)
DIM PaddleBak%(102) '10x40
SCREEN 12
_FULLSCREEN
PRINT "HELLO WORLD"
PLAY "ageba"
PRINT "Can anyone tell me who owns this code ? "
CX = 20: CY = 10: oldcx = CX: oldcy = CY
px = 420: py = 440: oldpx = px: oldpy = py
GOSUB MakBall
GOSUB MakMask
CLS
GOSUB MakBackground
Horizontal = 4: Vertical = 4
DO
Past! = TIMER
GOSUB GetKey
PUT (oldpx, oldpy), PaddleBak%(0), PSET
PUT (oldcx, oldcy), Background%(0), PSET
GET (px, py)-(px + 39, py + 9), PaddleBak%(0)
GET (CX, CY)-(CX + 19, CY + 19), Background%(0)
LINE (px, py)-(px + 39, py + 9), 3, BF
PUT (CX, CY), Mask%(0), AND 'draw ball
PUT (CX, CY), Ball%(0), XOR 'draw ball
GOSUB Movement
GOSUB Boundary
WHILE Past! = TIMER: WEND
LOOP WHILE INKEY$ <> CHR$(27)
SYSTEM
'-GOSUBS
GetKey:
a% = 0
a$ = INKEY$
a$ = RIGHT$(a$, 1)
IF LEN(a$) > 0 THEN a% = ASC(a$)
RETURN
MakBall:
CIRCLE (9, 9), 9, 12
PAINT (9, 9), 2, 12
GET (0, 0)-(19, 19), Ball%(0)
RETURN
MakMask:
FOR x = 0 TO 19
FOR y = 0 TO 19
z = POINT(x, y)
IF z <> 0 THEN PSET (x, y), 0 ELSE PSET (x, y), 8
NEXT y
NEXT x
GET (0, 0)-(19, 19), Mask%(0)
RETURN
MakBackground:
FOR x = 0 TO 699 STEP 3
LINE (x, 10)-(x - 50, 470), 7
NEXT x
GET (CX, CY)-(CX + 19, CY + 19), Background%(0)
GET (px, py)-(px + 39, py + 9), PaddleBak%(0)
RETURN
Movement:
oldcx = CX: oldcy = CY
CX = CX + Horizontal
CY = CY + Vertical
oldpx = px: oldpy = py
IF a% = 75 THEN
px = px - 4
IF px < 10 THEN px = 10
END IF
IF a% = 77 THEN
px = px + 4
IF px > 590 THEN px = 590
END IF
RETURN
Boundary:
IF CX <= 10 THEN
CX = 10
Horizontal = -Horizontal
END IF
IF CX >= 620 THEN
CX = 620
Horizontal = -Horizontal
END IF
IF CY <= 10 THEN
CY = 10
Vertical = -Vertical
END IF
IF CY >= 420 THEN
IF CX >= px AND CX <= px + 39 THEN
CY = 420
Vertical = -Vertical
END IF
END IF
IF CY > 460 THEN END
RETURN
Report Spam
Logged
From Garry
http://www.garryricketsonartworks.com/SMF
http://www.garryricketsonartworks.com/phpbbforum
http://www.garryricketsonartworks.org
http://www.garryspages.webs.com
http://wittywittywhatisthat.freesmfhosting.com/index.php
http://www.garryricketsonartworks.com/FluxBB
GarrisonRicketson
Admin
Administrator
Hero Member
Posts: 583
Re: Bouncing ball
«
Reply #2
on:
September 07, 2011, 08:14:45 am »
Here is one that has paddles that work, "Clippy" posted it in a reply, on
He said the functions he wrote, but the variables were written by some one else,...
Code:
'Don't use INKEY$ if you want to control 2 players:
SCREEN 12
' Set aside enough space to hold the sprite
' Draw a filled circle for our sprite
ON ERROR GOTO errorhandle
DIM ball%(1000000)
CIRCLE (4, 3), 4, 4
PAINT (4, 3), 12, 4
' Get the sprite into the Ball% array
GET (0, 0)-(8, 7), ball%(0)
ponescore = 0
ptwoscore = 0
begin:
char = char + 1
numb = numb + 38
CLS
xmin = 10
ymin = 10
xmax = 630
ymax = 470
x = 25
y = 25
dx = 1
dy = 1
curpos = 50
curtpos = 50
DO: _LIMIT 100 'adjust higher for faster
CLS
' program or game loop
IF ScanKey%(17) THEN curpos = curpos - 1
IF ScanKey%(31) THEN curpos = curpos + 1
IF ScanKey%(72) THEN curtpos = curtpos - 1
IF ScanKey%(80) THEN curtpos = curtpos + 1
zerocodes% = ScanKey%(0) 'reset all array values to zero for next part of program
PRINT "Player 1 : "; ponescore; " Player 2 : "; ptwoscore / 10
IF x > xmax - 15 AND y >= curtpos AND y <= curtpos + 100 THEN
dx = -1
ELSEIF x > xmax THEN
ponescore = ponescore + 1
END IF
IF x < xmin + 15 AND y >= curpos AND y <= curpos + 100 THEN
dx = 1
ELSEIF x < xmin THEN
ptwoscore = ptwoscore + 1
END IF
IF y > ymax - 5 THEN dy = -1
IF y < ymin + 5 THEN dy = 1
' Display the sprite elsewhere on the screen
x = x + dx
y = y + dy
PUT (x, y), ball%(0)
LINE (20, curpos)-(20, curpos + 100)
LINE (620, curtpos)-(620, curtpos + 100)
_DISPLAY 'shows completed screen every call
LOOP
errorhandle:
RESUME begin
FUNCTION ScanKey% (scancode%)
STATIC Ready%, keyflags%()
IF NOT Ready% THEN REDIM keyflags%(0 TO 127): Ready% = -1
i% = INP(&H60) 'read keyboard states
IF (i% AND 128) THEN keyflags%(i% XOR 128) = 0
IF (i% AND 128) = 0 THEN keyflags%(i%) = -1
K$ = INKEY$
ScanKey% = keyflags%(scancode%)
IF scancode% = 0 THEN Ready% = 0 'allows program to reset all values to 0 with a REDIM
END FUNCTION
A good excersise, and basis, that some one could build on. If anyone has any good ideas, as to what more can be done with this, that will make a good lesson in the next week or so, to see what diifferent ways there are to do this.
from Garry
«
Last Edit: September 07, 2011, 08:27:35 am by GarrisonRicketson
»
Report Spam
Logged
From Garry
http://www.garryricketsonartworks.com/SMF
http://www.garryricketsonartworks.com/phpbbforum
http://www.garryricketsonartworks.org
http://www.garryspages.webs.com
http://wittywittywhatisthat.freesmfhosting.com/index.php
http://www.garryricketsonartworks.com/FluxBB
Pages: [
1
]
Print
« previous
next »
Jump to:
Please select a destination:
-----------------------------
General Category
-----------------------------
=> Useful Information ,Rules,FAQs,LINKS,etc.
===> INTRODUCE Yourself
=> General QB64 Forum
=> MS DOS, FREE DOS, ANY DOS
-----------------------------
QB64 lessons and tutorials,Games
-----------------------------
=> Lesson Disussion
=> Weekly Lesson
=> Games
-----------------------------
TUTORIALS
-----------------------------
=> QB64 Tutorials
=> Text Adventure
=> QBasic Tutorials
=> Other Tutorials
-----------------------------
UNSEENS GDK+SFML Librarys
-----------------------------
=> Discussions on GDK+SFML
=> GDK+SFML Demos, and projects
-----------------------------
DEMOS
-----------------------------
=> Working QB64 Demos
=> QB64 Games
=> QB64 Programs You Are Proud Of.
=> Function + SUB Club
-----------------------------
OFF TOPIC,and Off The wall
-----------------------------
=> OffTopic and Off the Wall
Powered by
EzPortal
Loading...