Weekly Qbasic and Qb64 Lesson Topics
July 18, 2018, 07:46:52 am
Welcome, Guest. Please login or register.
Did you miss your activation email?

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


Pages: [1]
  Print  
Author Topic: Bouncing ball  (Read 476 times)
Dustie Bear
Full Member
***
Posts: 115


« 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

Social Buttons

GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« 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

GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« 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


Pages: [1]
  Print  
 
Jump to:  

Powered by EzPortal
Bookmark this site! | Upgrade This Forum
SMF For Free - Create your own Forum

Buy traffic for your forum/website
traffic-masters
Powered by SMF | SMF © 2016, Simple Machines
Privacy Policy