Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Small Program
- Thread starter TonyPo
- Start date
qbasicking
Programmer
If you type in "qbasic games" into any search engine it will come up with plenty of results. Some places to find simple games would be or you will find anything you need.
Here is a little pong game that I found on the internet and thought was pretty cool. There is some sloppy code, but its alright for a beginner to learn from.
' Airhockey ver. 1: Please mail comments to speige@hotmail.com
DECLARE FUNCTION MouseInit% ()
DECLARE SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
DECLARE SUB MouseRange (X1%, Y1%, x2%, Y2%)
DECLARE SUB MousePut (x%, y%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MouseShow ()
DEFINT A-Z:
CLEAR
CLS
SCREEN 9, 0, 1, 0
CLS
DEF SEG = &HA000:
DIM SHARED mouse$: mouse$ = SPACE$(57)
FOR I% = 1 TO 57: READ a$: H$ = CHR$(VAL("&H" + a$))
MID$(mouse$, I%, 1) = H$: NEXT I%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
RESTORE
ms% = MouseInit%
IF NOT ms% THEN
PRINT "Mouse not found"
SYSTEM
END IF
CLS
arcade: OPEN "air.arc" FOR APPEND AS #1: CLOSE #1
OPEN "air.arc" FOR INPUT AS #1
IF EOF(1) THEN CLOSE #1: GOTO newoptions
INPUT #1, difficulty
IF EOF(1) THEN CLOSE #1: GOTO newoptions
INPUT #1, aircompmove
IF EOF(1) THEN CLOSE #1: GOTO newoptions
INPUT #1, win
CLOSE #1
PRINT " 1. 1P Airhockey"
PRINT " 2. 2P Airhockey"
PRINT " 3. Options"
PRINT " 4. Quit"
PCOPY 1, 0
DO
b$ = INKEY$
LOOP UNTIL b$ <> ""
game$ = b$
IF game$ = "1" THEN players = 1: GOTO airhockey
IF game$ = "2" THEN players = 2: GOTO airhockey
IF game$ = "3" THEN GOTO options
IF game$ = "4" THEN SYSTEM
CLS
GOTO arcade
airhockey: MouseRange 111, 198, 529, 306
MouseHide
MousePut 320, 300
MouseHide
runs = 0: rise = 0
CLS
OUT 968, 1
OUT 969, 0
OUT 969, 0
OUT 969, 63
OUT 968, 2
OUT 969, 0
OUT 969, 0
OUT 969, 43
OUT 968, 3
OUT 969, 0
OUT 969, 0
OUT 969, 23
OUT 968, 4
OUT 969, 30
OUT 969, 30
OUT 969, 0
OUT 968, 5
OUT 969, 63
OUT 969, 63
OUT 969, 0
OUT 968, 6
OUT 969, 63
OUT 969, 0
OUT 969, 0
LINE (0, 0)-(640, 350), 1, BF
LINE (40, 10)-(600, 340), 0, BF
LINE (41, 11)-(599, 339), 2, BF
LINE (80, 21)-(560, 329), 0, B
LINE (81, 22)-(559, 328), 3, BF
LINE (40, 10)-(80, 20), 0
LINE (40, 340)-(80, 330), 0
LINE (600, 10)-(560, 20), 0
LINE (600, 340)-(560, 330), 0
LINE (220, 18)-(420, 21), 3, BF
LINE (220, 332)-(420, 329), 3, BF
p1x = 320: p1y = 50
px = 320: py = 175
GOSUB drawp1paddle
GOSUB drawpuck
DO
oldx = x: oldy = y: oldpy = py: oldpx = px: oldp1x = p1x: oldp1y = p1y
b$ = INKEY$
MouseStatus Lb%, Rb%, x, y
CIRCLE (px, py), 30, 3
PAINT (px, py), 3, 3
CIRCLE (p1x, p1y), 30, 3
PAINT (p1x, p1y), 3, 3
CIRCLE (oldx, oldy), 30, 3
PAINT (oldx, oldy), 3, 3
PAINT (1, 1), 1, 1
RANDOMIZE TIMER
IF players = 1 THEN aircompmove = RND * difficulty
oldp1x = p1x: oldp1y = p1y
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
IF aircompmove > p1distance THEN aircompmove = p1distance
IF players = 1 THEN
IF p1x > px AND p1distance > 44 THEN p1x = p1x - aircompmove
IF p1x < px AND p1distance > 44 THEN p1x = p1x + aircompmove
IF p1y > py AND p1distance > 44 THEN p1y = p1y - aircompmove
IF p1y < py AND p1distance > 44 THEN p1y = p1y + aircompmove
END IF
IF players = 2 THEN
IF b$ = "7" THEN p1x = p1x - aircompmove: p1y = p1y - aircompmove
IF b$ = "8" THEN p1y = p1y - aircompmove
IF b$ = "9" THEN p1x = p1x + aircompmove: p1y = p1y - aircompmove
IF b$ = "4" THEN p1x = p1x - aircompmove
IF b$ = "6" THEN p1x = p1x + aircompmove
IF b$ = "1" THEN p1x = p1x - aircompmove: p1y = p1y + aircompmove
IF b$ = "2" THEN p1y = p1y + aircompmove
IF b$ = "3" THEN p1x = p1x + aircompmove: p1y = p1y + aircompmove
END IF
IF p1y < 45 THEN p1y = 45
IF p1y > 152 THEN p1y = 152
IF p1x < 111 THEN p1x = 111
IF p1x > 529 THEN p1x = 529
px = px + runs
py = py + rise
IF py < 46 AND px > 235 AND px < 405 THEN fscore = fscore + 1: GOTO airhockey
IF py > 306 AND px > 235 AND px < 405 THEN lscore = lscore + 1: GOTO airhockey
IF py < 45 THEN py = 45: rise = -1 * (rise)
IF py > 306 THEN py = 306: rise = -1 * (rise)
IF px < 111 THEN px = 111: runs = -1 * (runs)
IF px > 529 THEN px = 529: runs = -1 * (runs)
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
p2distance = ABS(SQR(((x - px) ^ 2) + ((y - py) ^ 2)))
IF p1distance < 44 THEN
rise = (py - p1y): runs = (px - p1x)
IF p1x > px THEN px = p1x - 31
IF p1x < px THEN px = p1x + 31
IF p1y > py THEN py = p1y - 31
IF p1y < py THEN py = p1y + 31
END IF
IF p2distance < 44 THEN
rise = (py - y): runs = (px - x)
IF x > px THEN px = x - 31
IF x < px THEN px = x + 31
IF y > py THEN py = y - 31
IF y < py THEN py = y + 31
END IF
DO
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
p2distance = ABS(SQR(((x - px) ^ 2) + ((y - py) ^ 2)))
IF p1distance < 44 THEN rise = (py - p1y): runs = (px - p1x): px = px + runs: py = py + rise
IF p2distance < 44 THEN rise = (py - y): runs = (px - x): px = px + runs: py = py + rise
IF py < 46 AND px > 235 AND px < 405 THEN fscore = fscore + 1: GOTO airhockey
IF py > 306 AND px > 235 AND px < 405 THEN lscore = lscore + 1: GOTO airhockey
IF py < 45 THEN py = 45: rise = -1 * (rise)
IF py > 306 THEN py = 306: rise = -1 * (rise)
IF px < 111 THEN px = 111: runs = -1 * (runs)
IF px > 529 THEN px = 529: runs = -1 * (runs)
times = times + 1
IF times > 10 THEN
times = 0
IF oldx > oldpx AND x < px AND py + 31 > y AND py - 31 < y AND oldpy + 31 > oldy AND oldpy - 31 < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldx < oldpx AND x > px AND py + 31 > y AND py - 31 < y AND oldpy + 31 > oldy AND oldpy - 31 < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldy > oldpy AND y < py AND px + 31 > x AND px - 31 < x AND oldpx + 31 > oldx AND oldpx - 31 < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldy < oldpy AND y > py AND px + 31 > x AND px - 31 < x AND oldpx + 31 > oldx AND oldpx - 31 < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldx > oldpx AND x < px AND oldpy > oldy AND py < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldx < oldpx AND x > px AND oldpy > oldy AND py < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldy > oldpy AND y < py AND oldpx > oldx AND px < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldy < oldpy AND y > py AND oldpx > oldx AND px < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldx > oldpx AND x < px AND oldpy < oldy AND py > y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldx < oldpx AND x > px AND oldpy < oldy AND py > y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldy > oldpy AND y < py AND oldpx < oldx AND px > x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldy < oldpy AND y > py AND oldpx < oldx AND px > x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldp1x > oldpx AND p1x < px AND py + 31 > p1y AND py - 31 < p1y AND oldpy + 31 > oldp1y AND oldpy - 31 < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1x < oldpx AND p1x > px AND py + 31 > p1y AND py - 31 < p1y AND oldpy + 31 > oldp1y AND oldpy - 31 < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1y > oldpy AND p1y < py AND px + 31 > p1x AND px - 31 < p1x AND oldpx + 31 > oldp1x AND oldpx - 31 < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1y < oldpy AND p1y > py AND px + 31 > p1x AND px - 31 < p1x AND oldpx + 31 > oldp1x AND oldpx - 31 < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1x > oldpx AND p1x < px AND oldpy > oldp1y AND py < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1x < oldpx AND p1x > px AND oldpy > oldp1y AND py < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1y > oldpy AND p1y < py AND oldpx > oldp1x AND px < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1y < oldpy AND p1y > py AND oldpx > oldp1x AND px < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1x > oldpx AND p1x < px AND oldpy < oldp1y AND py > p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1x < oldpx AND p1x > px AND oldpy < oldp1y AND py > p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1y > oldpy AND p1y < py AND oldpx < oldp1x AND px > p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1y < oldpy AND p1y > py AND oldpx < oldp1x AND px > p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
DO
px = px + runs: py = py + rise
IF py < 46 AND px > 235 AND px < 405 THEN fscore = fscore + 1: GOTO airhockey
IF py > 306 AND px > 235 AND px < 405 THEN lscore = lscore + 1: GOTO airhockey
IF py < 45 THEN py = 45: rise = -1 * (rise)
IF py > 306 THEN py = 306: rise = -1 * (rise)
IF px < 111 THEN px = 111: runs = -1 * (runs)
IF px > 529 THEN px = 529: runs = -1 * (runs)
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
p2distance = ABS(SQR(((x - px) ^ 2) + ((y - py) ^ 2)))
IF p1distance < 44 THEN rise = (py - p1y): runs = (px - p1x)
IF p2distance < 44 THEN rise = (py - y): runs = (px - x)
times = times + 1
IF times > 10 THEN rise = INT(RND * 5): runs = INT(RND * 5)
IF times > 20 THEN GOTO airhockey
LOOP UNTIL p1distance > 44 AND p2distance > 44
END IF
LOOP UNTIL p1distance > 44 AND p2distance > 44 AND py >= 45 AND py <= 306 AND px >= 111 AND px <= 529
times = 0
GOSUB drawpuck
GOSUB drawp1paddle
GOSUB drawp2paddle
COLOR 6
LOCATE 3, 76
IF lscore < 10 THEN PRINT " ";
IF lscore < 100 THEN PRINT " ";
PRINT lscore
LOCATE 23, 76
IF fscore < 10 THEN PRINT " ";
IF fscore < 100 THEN PRINT " ";
PRINT fscore
LINE (601, 21)-(638, 48), 1, B
LINE (602, 22)-(637, 47), 1, B
LINE (603, 23)-(636, 46), 8, B
LINE (604, 24)-(635, 45), 7, B
LINE (605, 25)-(634, 44), 15, B
LINE (606, 26)-(633, 43), 7, B
LINE (607, 27)-(632, 42), 8, B
LINE (601, 301)-(638, 328), 1, B
LINE (602, 302)-(637, 327), 1, B
LINE (603, 303)-(636, 326), 8, B
LINE (604, 304)-(635, 325), 7, B
LINE (605, 305)-(634, 324), 15, B
LINE (606, 306)-(633, 323), 7, B
LINE (607, 307)-(632, 322), 8, B
IF fscore >= win OR lscore >= win THEN GOTO quitairhockey
PCOPY 1, 0
LOOP UNTIL b$ = CHR$(27)
GOTO quitairhockey
drawpuck: CIRCLE (px, py), 30, 4
PAINT (px, py), 5, 4
CIRCLE (px, py), 20, 4
RETURN
drawp1paddle: CIRCLE (p1x, p1y), 30, 0
PAINT (p1x, p1y), 0, 0
CIRCLE (p1x, p1y), 29, 8
PAINT (p1x, p1y), 8, 8
CIRCLE (p1x, p1y), 27, 7
PAINT (p1x, p1y), 7, 7
CIRCLE (p1x, p1y), 25, 15
PAINT (p1x, p1y), 15, 15
CIRCLE (p1x, p1y), 21, 7
PAINT (p1x, p1y), 7, 7
CIRCLE (p1x, p1y), 18, 8
PAINT (p1x, p1y), 8, 8
CIRCLE (p1x, p1y), 16, 0
PAINT (p1x, p1y), 0, 0
CIRCLE (p1x, p1y), 12, 8
PAINT (p1x, p1y), 8, 8
CIRCLE (p1x, p1y), 10, 7
PAINT (p1x, p1y), 7, 7
CIRCLE (p1x, p1y), 8, 15
PAINT (p1x, p1y), 15, 15
RETURN
drawp2paddle: CIRCLE (x, y), 30, 0
PAINT (x, y), 0, 0
CIRCLE (x, y), 29, 8
PAINT (x, y), 8, 8
CIRCLE (x, y), 27, 7
PAINT (x, y), 7, 7
CIRCLE (x, y), 25, 15
PAINT (x, y), 15, 15
CIRCLE (x, y), 21, 7
PAINT (x, y), 7, 7
CIRCLE (x, y), 18, 8
PAINT (x, y), 8, 8
CIRCLE (x, y), 16, 0
PAINT (x, y), 0, 0
CIRCLE (x, y), 12, 8
PAINT (x, y), 8, 8
CIRCLE (x, y), 10, 7
PAINT (x, y), 7, 7
CIRCLE (x, y), 8, 15
PAINT (x, y), 15, 15
RETURN
quitairhockey: IF fscore > lscore THEN difficulty = difficulty + (fscore - lscore) / 2
IF fscore < lscore THEN difficulty = difficulty - (lscore - fscore) / 2
OPEN "air.arc" FOR OUTPUT AS #1
PRINT #1, difficulty
PRINT #1, aircompmove
PRINT #1, win
CLOSE #1
IF fscore >= 999 THEN
CLS
PRINT "You Are The Ultimate Master of AirHockey!!!, Please Mail Your Comments About This Game to: speige@hotmail.com Thank You"
PRINT "press any key to continue"
PCOPY 1, 0
DO
LOOP UNTIL INKEY$ <> ""
END IF
CLEAR
RUN
options: CLS
PRINT " 1. Difficulty"
PRINT " 2. P2 Sensitivity"
PRINT " 3. Winning Score"
PRINT " 4. Quit Options"
PCOPY 1, 0
DO
b$ = INKEY$
LOOP UNTIL b$ <> ""
option$ = b$
IF option$ = "1" THEN
CLS
SCREEN 12
INPUT "What is the new difficulty? ", difficulty
IF difficulty > 50 THEN difficulty = 50
IF difficulty < 10 THEN difficulty = 10
END IF
IF option$ = "2" THEN
CLS
SCREEN 12
INPUT "What is Player 2's new sensitivity? ", aircompmove
IF aircompmove < 10 THEN aircompmove = 10
IF aircompmove > 50 THEN aircompmove = 50
END IF
IF option$ = "3" THEN
CLS
SCREEN 12
INPUT "What is the new winning score? ", win
IF win > 1000 THEN win = 1000
IF win < 1 THEN win = 1
END IF
IF option$ = "4" THEN RUN
OPEN "air.arc" FOR OUTPUT AS #1
PRINT #1, difficulty
PRINT #1, aircompmove
PRINT #1, win
CLOSE #1
CLS
SCREEN 9, 0, 1, 0
CLS
GOTO options
newoptions: OPEN "air.arc" FOR OUTPUT AS #1
PRINT #1, 30
PRINT #1, 30
PRINT #1, 15
CLOSE #1
RUN
DEFLNG A-Z
SUB MouseDriver (ax%, bx%, cx%, dx%)
DEF SEG = VARSEG(mouse$)
mouse% = SADD(mouse$)
CALL Absolute(ax%, bx%, cx%, dx%, mouse%)
END SUB
SUB MouseHide
ax% = 2
MouseDriver ax%, 0, 0, 0
END SUB
FUNCTION MouseInit%
ax% = 0
MouseDriver ax%, 0, 0, 0
MouseInit% = ax%
END FUNCTION
SUB MousePut (x%, y%)
ax% = 4
cx% = x%
dx% = y%
MouseDriver ax%, 0, cx%, dx%
END SUB
SUB MouseRange (X1%, Y1%, x2%, Y2%)
ax% = 7
cx% = X1%
dx% = x2%
MouseDriver ax%, 0, cx%, dx%
ax% = 8
cx% = Y1%
dx% = Y2%
MouseDriver ax%, 0, cx%, dx%
END SUB
SUB MouseShow
ax% = 1
MouseDriver ax%, 0, 0, 0
END SUB
SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
ax% = 3
MouseDriver ax%, bx%, cx%, dx%
Lb% = ((bx% AND 1) <> 0)
Rb% = ((bx% AND 2) <> 0)
xMouse% = cx%
yMouse% = dx%
END SUB
Here is a little pong game that I found on the internet and thought was pretty cool. There is some sloppy code, but its alright for a beginner to learn from.
' Airhockey ver. 1: Please mail comments to speige@hotmail.com
DECLARE FUNCTION MouseInit% ()
DECLARE SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
DECLARE SUB MouseRange (X1%, Y1%, x2%, Y2%)
DECLARE SUB MousePut (x%, y%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MouseShow ()
DEFINT A-Z:
CLEAR
CLS
SCREEN 9, 0, 1, 0
CLS
DEF SEG = &HA000:
DIM SHARED mouse$: mouse$ = SPACE$(57)
FOR I% = 1 TO 57: READ a$: H$ = CHR$(VAL("&H" + a$))
MID$(mouse$, I%, 1) = H$: NEXT I%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
RESTORE
ms% = MouseInit%
IF NOT ms% THEN
PRINT "Mouse not found"
SYSTEM
END IF
CLS
arcade: OPEN "air.arc" FOR APPEND AS #1: CLOSE #1
OPEN "air.arc" FOR INPUT AS #1
IF EOF(1) THEN CLOSE #1: GOTO newoptions
INPUT #1, difficulty
IF EOF(1) THEN CLOSE #1: GOTO newoptions
INPUT #1, aircompmove
IF EOF(1) THEN CLOSE #1: GOTO newoptions
INPUT #1, win
CLOSE #1
PRINT " 1. 1P Airhockey"
PRINT " 2. 2P Airhockey"
PRINT " 3. Options"
PRINT " 4. Quit"
PCOPY 1, 0
DO
b$ = INKEY$
LOOP UNTIL b$ <> ""
game$ = b$
IF game$ = "1" THEN players = 1: GOTO airhockey
IF game$ = "2" THEN players = 2: GOTO airhockey
IF game$ = "3" THEN GOTO options
IF game$ = "4" THEN SYSTEM
CLS
GOTO arcade
airhockey: MouseRange 111, 198, 529, 306
MouseHide
MousePut 320, 300
MouseHide
runs = 0: rise = 0
CLS
OUT 968, 1
OUT 969, 0
OUT 969, 0
OUT 969, 63
OUT 968, 2
OUT 969, 0
OUT 969, 0
OUT 969, 43
OUT 968, 3
OUT 969, 0
OUT 969, 0
OUT 969, 23
OUT 968, 4
OUT 969, 30
OUT 969, 30
OUT 969, 0
OUT 968, 5
OUT 969, 63
OUT 969, 63
OUT 969, 0
OUT 968, 6
OUT 969, 63
OUT 969, 0
OUT 969, 0
LINE (0, 0)-(640, 350), 1, BF
LINE (40, 10)-(600, 340), 0, BF
LINE (41, 11)-(599, 339), 2, BF
LINE (80, 21)-(560, 329), 0, B
LINE (81, 22)-(559, 328), 3, BF
LINE (40, 10)-(80, 20), 0
LINE (40, 340)-(80, 330), 0
LINE (600, 10)-(560, 20), 0
LINE (600, 340)-(560, 330), 0
LINE (220, 18)-(420, 21), 3, BF
LINE (220, 332)-(420, 329), 3, BF
p1x = 320: p1y = 50
px = 320: py = 175
GOSUB drawp1paddle
GOSUB drawpuck
DO
oldx = x: oldy = y: oldpy = py: oldpx = px: oldp1x = p1x: oldp1y = p1y
b$ = INKEY$
MouseStatus Lb%, Rb%, x, y
CIRCLE (px, py), 30, 3
PAINT (px, py), 3, 3
CIRCLE (p1x, p1y), 30, 3
PAINT (p1x, p1y), 3, 3
CIRCLE (oldx, oldy), 30, 3
PAINT (oldx, oldy), 3, 3
PAINT (1, 1), 1, 1
RANDOMIZE TIMER
IF players = 1 THEN aircompmove = RND * difficulty
oldp1x = p1x: oldp1y = p1y
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
IF aircompmove > p1distance THEN aircompmove = p1distance
IF players = 1 THEN
IF p1x > px AND p1distance > 44 THEN p1x = p1x - aircompmove
IF p1x < px AND p1distance > 44 THEN p1x = p1x + aircompmove
IF p1y > py AND p1distance > 44 THEN p1y = p1y - aircompmove
IF p1y < py AND p1distance > 44 THEN p1y = p1y + aircompmove
END IF
IF players = 2 THEN
IF b$ = "7" THEN p1x = p1x - aircompmove: p1y = p1y - aircompmove
IF b$ = "8" THEN p1y = p1y - aircompmove
IF b$ = "9" THEN p1x = p1x + aircompmove: p1y = p1y - aircompmove
IF b$ = "4" THEN p1x = p1x - aircompmove
IF b$ = "6" THEN p1x = p1x + aircompmove
IF b$ = "1" THEN p1x = p1x - aircompmove: p1y = p1y + aircompmove
IF b$ = "2" THEN p1y = p1y + aircompmove
IF b$ = "3" THEN p1x = p1x + aircompmove: p1y = p1y + aircompmove
END IF
IF p1y < 45 THEN p1y = 45
IF p1y > 152 THEN p1y = 152
IF p1x < 111 THEN p1x = 111
IF p1x > 529 THEN p1x = 529
px = px + runs
py = py + rise
IF py < 46 AND px > 235 AND px < 405 THEN fscore = fscore + 1: GOTO airhockey
IF py > 306 AND px > 235 AND px < 405 THEN lscore = lscore + 1: GOTO airhockey
IF py < 45 THEN py = 45: rise = -1 * (rise)
IF py > 306 THEN py = 306: rise = -1 * (rise)
IF px < 111 THEN px = 111: runs = -1 * (runs)
IF px > 529 THEN px = 529: runs = -1 * (runs)
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
p2distance = ABS(SQR(((x - px) ^ 2) + ((y - py) ^ 2)))
IF p1distance < 44 THEN
rise = (py - p1y): runs = (px - p1x)
IF p1x > px THEN px = p1x - 31
IF p1x < px THEN px = p1x + 31
IF p1y > py THEN py = p1y - 31
IF p1y < py THEN py = p1y + 31
END IF
IF p2distance < 44 THEN
rise = (py - y): runs = (px - x)
IF x > px THEN px = x - 31
IF x < px THEN px = x + 31
IF y > py THEN py = y - 31
IF y < py THEN py = y + 31
END IF
DO
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
p2distance = ABS(SQR(((x - px) ^ 2) + ((y - py) ^ 2)))
IF p1distance < 44 THEN rise = (py - p1y): runs = (px - p1x): px = px + runs: py = py + rise
IF p2distance < 44 THEN rise = (py - y): runs = (px - x): px = px + runs: py = py + rise
IF py < 46 AND px > 235 AND px < 405 THEN fscore = fscore + 1: GOTO airhockey
IF py > 306 AND px > 235 AND px < 405 THEN lscore = lscore + 1: GOTO airhockey
IF py < 45 THEN py = 45: rise = -1 * (rise)
IF py > 306 THEN py = 306: rise = -1 * (rise)
IF px < 111 THEN px = 111: runs = -1 * (runs)
IF px > 529 THEN px = 529: runs = -1 * (runs)
times = times + 1
IF times > 10 THEN
times = 0
IF oldx > oldpx AND x < px AND py + 31 > y AND py - 31 < y AND oldpy + 31 > oldy AND oldpy - 31 < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldx < oldpx AND x > px AND py + 31 > y AND py - 31 < y AND oldpy + 31 > oldy AND oldpy - 31 < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldy > oldpy AND y < py AND px + 31 > x AND px - 31 < x AND oldpx + 31 > oldx AND oldpx - 31 < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldy < oldpy AND y > py AND px + 31 > x AND px - 31 < x AND oldpx + 31 > oldx AND oldpx - 31 < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldx > oldpx AND x < px AND oldpy > oldy AND py < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldx < oldpx AND x > px AND oldpy > oldy AND py < y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldy > oldpy AND y < py AND oldpx > oldx AND px < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldy < oldpy AND y > py AND oldpx > oldx AND px < x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldx > oldpx AND x < px AND oldpy < oldy AND py > y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldx < oldpx AND x > px AND oldpy < oldy AND py > y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = x - 31
IF oldy > oldpy AND y < py AND oldpx < oldx AND px > x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldy < oldpy AND y > py AND oldpx < oldx AND px > x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = y - 31
IF oldp1x > oldpx AND p1x < px AND py + 31 > p1y AND py - 31 < p1y AND oldpy + 31 > oldp1y AND oldpy - 31 < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1x < oldpx AND p1x > px AND py + 31 > p1y AND py - 31 < p1y AND oldpy + 31 > oldp1y AND oldpy - 31 < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1y > oldpy AND p1y < py AND px + 31 > p1x AND px - 31 < p1x AND oldpx + 31 > oldp1x AND oldpx - 31 < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1y < oldpy AND p1y > py AND px + 31 > p1x AND px - 31 < p1x AND oldpx + 31 > oldp1x AND oldpx - 31 < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1x > oldpx AND p1x < px AND oldpy > oldp1y AND py < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1x < oldpx AND p1x > px AND oldpy > oldp1y AND py < p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1y > oldpy AND p1y < py AND oldpx > oldp1x AND px < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1y < oldpy AND p1y > py AND oldpx > oldp1x AND px < p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1x > oldpx AND p1x < px AND oldpy < oldp1y AND py > p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1x < oldpx AND p1x > px AND oldpy < oldp1y AND py > p1y THEN rise = (py - p1y): runs = (px - p1x): runs = -1 * (runs): px = p1x - 31
IF oldp1y > oldpy AND p1y < py AND oldpx < oldp1x AND px > p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
IF oldp1y < oldpy AND p1y > py AND oldpx < oldp1x AND px > p1x THEN rise = (py - p1y): runs = (px - p1x): rise = -1 * (rise): py = p1y - 31
DO
px = px + runs: py = py + rise
IF py < 46 AND px > 235 AND px < 405 THEN fscore = fscore + 1: GOTO airhockey
IF py > 306 AND px > 235 AND px < 405 THEN lscore = lscore + 1: GOTO airhockey
IF py < 45 THEN py = 45: rise = -1 * (rise)
IF py > 306 THEN py = 306: rise = -1 * (rise)
IF px < 111 THEN px = 111: runs = -1 * (runs)
IF px > 529 THEN px = 529: runs = -1 * (runs)
p1distance = ABS(SQR(((p1x - px) ^ 2) + ((p1y - py) ^ 2)))
p2distance = ABS(SQR(((x - px) ^ 2) + ((y - py) ^ 2)))
IF p1distance < 44 THEN rise = (py - p1y): runs = (px - p1x)
IF p2distance < 44 THEN rise = (py - y): runs = (px - x)
times = times + 1
IF times > 10 THEN rise = INT(RND * 5): runs = INT(RND * 5)
IF times > 20 THEN GOTO airhockey
LOOP UNTIL p1distance > 44 AND p2distance > 44
END IF
LOOP UNTIL p1distance > 44 AND p2distance > 44 AND py >= 45 AND py <= 306 AND px >= 111 AND px <= 529
times = 0
GOSUB drawpuck
GOSUB drawp1paddle
GOSUB drawp2paddle
COLOR 6
LOCATE 3, 76
IF lscore < 10 THEN PRINT " ";
IF lscore < 100 THEN PRINT " ";
PRINT lscore
LOCATE 23, 76
IF fscore < 10 THEN PRINT " ";
IF fscore < 100 THEN PRINT " ";
PRINT fscore
LINE (601, 21)-(638, 48), 1, B
LINE (602, 22)-(637, 47), 1, B
LINE (603, 23)-(636, 46), 8, B
LINE (604, 24)-(635, 45), 7, B
LINE (605, 25)-(634, 44), 15, B
LINE (606, 26)-(633, 43), 7, B
LINE (607, 27)-(632, 42), 8, B
LINE (601, 301)-(638, 328), 1, B
LINE (602, 302)-(637, 327), 1, B
LINE (603, 303)-(636, 326), 8, B
LINE (604, 304)-(635, 325), 7, B
LINE (605, 305)-(634, 324), 15, B
LINE (606, 306)-(633, 323), 7, B
LINE (607, 307)-(632, 322), 8, B
IF fscore >= win OR lscore >= win THEN GOTO quitairhockey
PCOPY 1, 0
LOOP UNTIL b$ = CHR$(27)
GOTO quitairhockey
drawpuck: CIRCLE (px, py), 30, 4
PAINT (px, py), 5, 4
CIRCLE (px, py), 20, 4
RETURN
drawp1paddle: CIRCLE (p1x, p1y), 30, 0
PAINT (p1x, p1y), 0, 0
CIRCLE (p1x, p1y), 29, 8
PAINT (p1x, p1y), 8, 8
CIRCLE (p1x, p1y), 27, 7
PAINT (p1x, p1y), 7, 7
CIRCLE (p1x, p1y), 25, 15
PAINT (p1x, p1y), 15, 15
CIRCLE (p1x, p1y), 21, 7
PAINT (p1x, p1y), 7, 7
CIRCLE (p1x, p1y), 18, 8
PAINT (p1x, p1y), 8, 8
CIRCLE (p1x, p1y), 16, 0
PAINT (p1x, p1y), 0, 0
CIRCLE (p1x, p1y), 12, 8
PAINT (p1x, p1y), 8, 8
CIRCLE (p1x, p1y), 10, 7
PAINT (p1x, p1y), 7, 7
CIRCLE (p1x, p1y), 8, 15
PAINT (p1x, p1y), 15, 15
RETURN
drawp2paddle: CIRCLE (x, y), 30, 0
PAINT (x, y), 0, 0
CIRCLE (x, y), 29, 8
PAINT (x, y), 8, 8
CIRCLE (x, y), 27, 7
PAINT (x, y), 7, 7
CIRCLE (x, y), 25, 15
PAINT (x, y), 15, 15
CIRCLE (x, y), 21, 7
PAINT (x, y), 7, 7
CIRCLE (x, y), 18, 8
PAINT (x, y), 8, 8
CIRCLE (x, y), 16, 0
PAINT (x, y), 0, 0
CIRCLE (x, y), 12, 8
PAINT (x, y), 8, 8
CIRCLE (x, y), 10, 7
PAINT (x, y), 7, 7
CIRCLE (x, y), 8, 15
PAINT (x, y), 15, 15
RETURN
quitairhockey: IF fscore > lscore THEN difficulty = difficulty + (fscore - lscore) / 2
IF fscore < lscore THEN difficulty = difficulty - (lscore - fscore) / 2
OPEN "air.arc" FOR OUTPUT AS #1
PRINT #1, difficulty
PRINT #1, aircompmove
PRINT #1, win
CLOSE #1
IF fscore >= 999 THEN
CLS
PRINT "You Are The Ultimate Master of AirHockey!!!, Please Mail Your Comments About This Game to: speige@hotmail.com Thank You"
PRINT "press any key to continue"
PCOPY 1, 0
DO
LOOP UNTIL INKEY$ <> ""
END IF
CLEAR
RUN
options: CLS
PRINT " 1. Difficulty"
PRINT " 2. P2 Sensitivity"
PRINT " 3. Winning Score"
PRINT " 4. Quit Options"
PCOPY 1, 0
DO
b$ = INKEY$
LOOP UNTIL b$ <> ""
option$ = b$
IF option$ = "1" THEN
CLS
SCREEN 12
INPUT "What is the new difficulty? ", difficulty
IF difficulty > 50 THEN difficulty = 50
IF difficulty < 10 THEN difficulty = 10
END IF
IF option$ = "2" THEN
CLS
SCREEN 12
INPUT "What is Player 2's new sensitivity? ", aircompmove
IF aircompmove < 10 THEN aircompmove = 10
IF aircompmove > 50 THEN aircompmove = 50
END IF
IF option$ = "3" THEN
CLS
SCREEN 12
INPUT "What is the new winning score? ", win
IF win > 1000 THEN win = 1000
IF win < 1 THEN win = 1
END IF
IF option$ = "4" THEN RUN
OPEN "air.arc" FOR OUTPUT AS #1
PRINT #1, difficulty
PRINT #1, aircompmove
PRINT #1, win
CLOSE #1
CLS
SCREEN 9, 0, 1, 0
CLS
GOTO options
newoptions: OPEN "air.arc" FOR OUTPUT AS #1
PRINT #1, 30
PRINT #1, 30
PRINT #1, 15
CLOSE #1
RUN
DEFLNG A-Z
SUB MouseDriver (ax%, bx%, cx%, dx%)
DEF SEG = VARSEG(mouse$)
mouse% = SADD(mouse$)
CALL Absolute(ax%, bx%, cx%, dx%, mouse%)
END SUB
SUB MouseHide
ax% = 2
MouseDriver ax%, 0, 0, 0
END SUB
FUNCTION MouseInit%
ax% = 0
MouseDriver ax%, 0, 0, 0
MouseInit% = ax%
END FUNCTION
SUB MousePut (x%, y%)
ax% = 4
cx% = x%
dx% = y%
MouseDriver ax%, 0, cx%, dx%
END SUB
SUB MouseRange (X1%, Y1%, x2%, Y2%)
ax% = 7
cx% = X1%
dx% = x2%
MouseDriver ax%, 0, cx%, dx%
ax% = 8
cx% = Y1%
dx% = Y2%
MouseDriver ax%, 0, cx%, dx%
END SUB
SUB MouseShow
ax% = 1
MouseDriver ax%, 0, 0, 0
END SUB
SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
ax% = 3
MouseDriver ax%, bx%, cx%, dx%
Lb% = ((bx% AND 1) <> 0)
Rb% = ((bx% AND 2) <> 0)
xMouse% = cx%
yMouse% = dx%
END SUB
qbasicking
Programmer
oh... it looks like a little bit of the program got word-wrapped, before you run it you will have to fix that, and I also don't see a use for the Mouseshow sub, I think you can delete that to make it less complicated
- Status
Similar threads
