'===========================================================================
' Subject: BOINKO (PONG WITH 4 PADDLES)       Date: 03-18-98 (21:13)       
'  Author: Dominick Aguilar                   Code: QB, QBasic, PDS        
'  Origin: BCase10582@aol.com               Packet: GAMES.ABC
'===========================================================================
DECLARE SUB mousestatus (lb%, rb%, xMouse%, yMouse%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB mouseshow ()
DECLARE FUNCTION mouseInit% ()
GOSUB 1000
1 CLS
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                      
ms% = mouseInit%
IF NOT ms% THEN
  PRINT "Mouse not found"
  END
END IF
mouseshow
SCREEN 12
2 CLS
score = 0
LOCATE 10, 12: INPUT " Number of balls you want? (1-100) (0 for instructions) "; balls: balls = INT(balls)
CLS
IF balls = 0 THEN GOSUB 1000
IF balls < 1 OR balls > 100 THEN 2
COLOR 10: LOCATE 10, 35: PRINT "GET READY"
FOR d = 1 TO 10000: NEXT d
CLS
5 COLOR 2
LINE (0, 400)-(600, 400)
COLOR 4: LINE (0, 0)-(600, 0)
LINE (0, 0)-(0, 400)
LINE (600, 0)-(600, 400)
ac = 0: xs = 5: ys = 400: t = 0: pi = 3.14159: a = pi / 3: v = 34: e = .95: vc = 0
mx = 0: my = 0: pac = 0: pbc = 0
10 REM
t = t + .005
x = xs + 30 * (v * t * COS(a))
y = ys + -30 * (v * t * SIN(a) - (16 * t ^ 2))
IF v < .15 THEN 5
IF ABS(INT(350 - y)) < 5 AND (ABS(INT(x) - x%)) < 20 THEN ac = ac + (pi / 180 * pac): vc = vc + ABS(2 * pac): score = score + INT(v): GOTO 400
IF ABS(INT(10 - y)) < 5 AND (ABS(INT(x) - x%)) < 20 THEN ac = ac + (pi / 180 * pac): vc = vc + ABS(2 * pac): score = score + INT(v): GOTO 300
IF ABS(INT(10 - x)) < 5 AND (ABS(INT(y) - y%)) < 20 THEN ac = ac + (pi / 180 * pbc): vc = vc + ABS(2 * pac): score = score + INT(v): GOTO 200
IF ABS(INT(590 - x)) < 5 AND (ABS(INT(y) - y%)) < 20 THEN ac = ac + (pi / 180 * pbc): vc = vc + ABS(2 * pac): score = score + INT(v): GOTO 100
IF INT(y) >= 400 THEN 400
IF INT(x) >= 600 THEN 500
IF INT(x) <= 0 THEN 500
IF INT(y) < 9.9 THEN 500
50 a$ = INKEY$
IF a$ = " " THEN vc = vc + 2
COLOR 0: CIRCLE (xc, yc), (3)
xc = x: yc = y
COLOR 2: CIRCLE (xc, yc), (3)
IF a$ = "." THEN ac = ac - (pi / 180): IF (a + ac) <= 0 THEN ac = ac + (pi / 180)
IF a$ = "," THEN ac = ac + (pi / 180): IF (a + ac) >= pi THEN ac = ac - (pi / 180)
LOCATE 27, 10: PRINT "Velocity: "; v + vc, "                     Angle: "; (a + ac) * (180 / pi)
LOCATE 28, 20: COLOR 11: PRINT "SCORE...."; score, : COLOR 9: PRINT "BALLS...."; balls
COLOR 0: LINE (x% - 15, 350)-(x% + 15, 350)
COLOR 0: LINE (590, y% - 15)-(590, y% + 15)
COLOR 0: LINE (x% - 15, 10)-(x% + 15, 10)
COLOR 0: LINE (10, y% - 15)-(10, y% + 15)
mx = x%: my = y%
mousestatus lb%, rb%, x%, y%
pac = mx - x%: pbc = my - y%
IF pac < -5 THEN pac = -5
IF pac > 5 THEN pac = 5
IF pbc < -5 THEN pbc = -5
IF pbc > 5 THEN pbc = 5
COLOR 6: LINE (x% - 15, 350)-(x% + 15, 350)
COLOR 7: LINE (590, y% - 15)-(590, y% + 15)
COLOR 6: LINE (x% - 15, 10)-(x% + 15, 10)
COLOR 7: LINE (10, y% - 15)-(10, y% + 15)
GOTO 10
100 REM
xs = x + (x - xs)
a = pi - a
SOUND 1000, .5
GOTO 10
200 REM
xs = x - xs + 15
a = pi - a
SOUND 1000, .5
GOTO 10
300 REM
301 t = t + .05
k = ys + -30 * (v * t * SIN(a) - (16 * t ^ 2))
kx = xs + (30 * v * t * (COS(a)))
IF INT(k) > y THEN 305
GOTO 301
305 SOUND 1000, .5
IF a <= (pi / 2) THEN 310
xs = xs + ABS(x - kx)
GOTO 10
310  xs = xs - (kx - x)
320  GOTO 10
400 REM
t = 0: v = vc + v * e: a = a + ac: ys = y: xs = x: SOUND 1000, .5: vc = 0: ac = 0
GOTO 10
500 LOCATE 10, 27
COLOR 3: PRINT "--------"; : COLOR 7: PRINT " out "; : COLOR 3: PRINT "-------"
LOCATE 11, 20
balls = balls - 1: IF balls = 0 THEN 510
LOCATE 12, 20: COLOR 5: PRINT "click left mouse button for next ball"
502 mousestatus lb%, rb%, x%, y%
IF lb% = -1 THEN CLS : GOTO 5
GOTO 502
510 COLOR 3: PRINT "   ------- No Balls Left -------"
LOCATE 13, 20: COLOR 10: PRINT "click left mouse button to play again"
515 mousestatus lb%, rb%, x%, y%
IF lb% = -1 THEN 2
GOTO 515
1000 CLS
COLOR 2
PRINT : PRINT "       ------------------- BOINKO INSTRUCTIONS --------------------"
PRINT : PRINT " Use mouse to move paddles and deflect ball before it hits RED walls."
PRINT : PRINT " Hitting ball while mouse is moving increases speed and changes angle."
PRINT : PRINT " <SPACE> bar also increases velocity. < and > change angle."
PRINT : PRINT "            Ball WILL bounce off of the ground (green)"
PRINT : PRINT "                           (ANY KEY TO PLAY)"
PRINT : PRINT "       -----------------------------------------------------------"
COLOR 5
PRINT : PRINT "  'BOINKO' By Dominick Aguilar  -----> E-Mail    BCase10582@aol.com"
PRINT "        Thanks to T2000J@aol.com for the mouse rountine!"
1010 a$ = INKEY$
IF a$ <> "" THEN RETURN
GOTO 1010

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 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
