'===========================================================================
' Subject: BUG SHOOT                          Date: 05-07-97 (01:40)       
'  Author: Jim Emptage                        Code: QB, PDS                
'  Origin: 75504.2526@Compuserve.com        Packet: GAMES.ABC
'===========================================================================
' dosdelay sub routine   Released to the   Public Domain   by Kurt Kuzba
' game by jim emptage 75504.2526@compuserve.com
' only authorized distributor is William Yu of All Basic Code
' works ok on my 486 DX266
' could use a better speed control
' my version has 14 bugs to shoot at and a high score feature
' but they are in separate data files and I wanted this to be
' a single file program for uploading
' if you improve this game send me a copy
' enjoy your QBasic hobby!
' jim emptage
DECLARE SUB dosdelay (seconds!)
DECLARE SUB FIRSTLOOP ()
DECLARE SUB INITIAL ()
DEFINT A-Y
DEFSNG Z
DECLARE SUB loadbug ()
DECLARE SUB boombug ()
DECLARE SUB RULES ()
DECLARE SUB wwait ()
DECLARE SUB tit ()
DECLARE SUB spidey ()
DECLARE SUB MOUSE (m0%, m1%, m2%, m3%)
DECLARE SUB hidemouse ()
DECLARE SUB showmouse ()
DECLARE SUB getmxy (mx%, my%)
DECLARE SUB setmxy (mx%, my%)
DECLARE SUB mborders (X%, y%, h%, v%)
DECLARE FUNCTION mbtn% ()
COMMON SHARED xx, yy, sx, sy, my%, mx%, clr, ODX, dy, DDX, ddy
COMMON SHARED s1, s2, score, turns, zcr, DOBUG, speed, X$
COMMON SHARED chx, chy, xu, yu, sss, xsh, YSH, ztx, zty
ON ERROR GOTO ERRS
TYPE RegType
  ax    AS INTEGER
  bx    AS INTEGER
  cx    AS INTEGER
  dx    AS INTEGER
  bp    AS INTEGER
  si    AS INTEGER
  di    AS INTEGER
  flags AS INTEGER
END TYPE
DIM SHARED sp(18, 18)  AS INTEGER
DIM SHARED nt AS STRING * 30
CALL loadbug
CALL RULES
speed = 1
SCREEN 13
FOR t = 101 TO 115
  yo = yo + 1
  PALETTE t, yo * 4
NEXT
PALETTE 200, 60
CALL hidemouse
CALL setmxy(5, 5)
LOCATE 1, 1, 0, 0, 0
DOBUG = 10
RESTART:
VIEW
VIEW (1, 1)-(319, 189)
s1 = 0
s2 = 1
score = 0
turns = 11
START:
turns = turns - 1
CLS
COLOR 12
LOCATE 25, 1
PRINT " SCORE: "; score;
COLOR 10
PRINT "  TURNS LEFT: "; turns;
COLOR 11
PRINT "  RVS ";
IF turns = 0 THEN
  COLOR 12
  LOCATE 12, 3
  PRINT " RVS BUG SHOOT  -  E N D OF GAME";
  DO
  LOOP WHILE INKEY$ = ""
  GOTO RESTART
END IF
RANDOMIZE TIMER
CALL INITIAL
1
X$ = ""
WHILE INKEY$ <> ""
WEND
IF sss = 0 THEN
  CALL FIRSTLOOP
END IF
IF sss = 1 THEN
  SWAP s1, s2
  IF s1 = 0 THEN
    CALL getmxy(ODX, dy)
    CALL spidey
  END IF
END IF
DDX = ODX
ddy = dy
PSET (xs + 1, ys + 1), 0
PSET (xs - 1, ys - 1), 0
PSET (xs - 1, ys + 1), 0
PSET (xs + 1, ys - 1), 0

IF X$ = "" THEN GOTO 11
IF X$ <> "" THEN
  SELECT CASE UCASE$(X$)
    CASE CHR$(27)                                 ' ESC
      PALETTE
      CALL tit
      END
    CASE "S"
      SOUND 80, 3
      speed = speed + 1
      IF speed = 6 THEN speed = 1
      LOCATE 25, 38
      PRINT speed;
      GOTO 1
  END SELECT
  GOTO 1
END IF
11


IF mbtn% <> 0 AND sss = 0 THEN
  CALL getmxy(xsh, YSH)
  IF YSH > 188 THEN GOTO 88
  IF xsh = 160 THEN xsh = 161
  PSET (xsh, YSH), 11
  sss = 1
  OAX = ABS(160 - xsh)
  ay = ABS(200 - YSH)
  zdx = OAX / ay
  da = 2000 * (zdx / 144)
  ztx = 160
  zty = 200
END IF
IF sss = 1 THEN
  FOR mmm = 1 TO da
  NEXT
  PSET (xsh, YSH), 11
  PSET (tempx, tempy), 0
  IF xsh > 160 THEN
    ztx = ztx + (zdx)
    zty = zty - (1)
  END IF
  IF xsh <= 160 THEN
    ztx = ztx - (zdx)
    zty = zty - (1)
  END IF
  tempx = ztx
  tempy = zty
  PSET (ztx, zty), 14
  IF ztx = xsh OR zty = YSH THEN
    FOR a = 15 TO 1 STEP -1
      CIRCLE (ztx, zty), a, a + 50
      PAINT (ztx, zty), a + 50, a + 50
      SOUND 40 + (a * 100), .1
    NEXT
    dosdelay .2
    f = 0
    IF ztx > 318 THEN f = 1
    IF ztx < 2 THEN f = -1
    CIRCLE (ztx, zty), 15, 100
    PAINT (ztx - f, zty), 0, 100
    CIRCLE (ztx, zty), 15, 0
    sss = 0
    uu = 5
    IF hhh = 0 THEN
      zXD& = ABS(ztx - (xu + 9))
      zYD& = ABS(zty - (yu + 9))
      zcr = SQR((zXD& * zXD&) + (zYD& * zYD&))
      IF zcr < 20 THEN hhh = 1
    END IF
    
    IF hhh = 1 THEN
      CALL boombug
      hhh = 0
      GOTO START
    END IF
    turns = turns - 1
    COLOR 12
    LOCATE 25, 1
    PRINT " SCORE: "; score;
    COLOR 10
    PRINT "  TURNS LEFT: "; turns;
    COLOR 11
    PRINT "  RVS ";
    IF turns = 0 THEN
      COLOR 12
      LOCATE 12, 3
      PRINT " RVS BUG SHOOT  -  E N D of game";
      DO
      LOOP WHILE INKEY$ = ""
      GOTO RESTART
    END IF
  END IF
END IF
88
IF sss = 0 THEN
  CALL getmxy(xs, ys)
  PSET (xs + 1, ys + 1), 200
  PSET (xs - 1, ys - 1), 200
  PSET (xs - 1, ys + 1), 200
  PSET (xs + 1, ys - 1), 200
END IF
GOTO 1
99
WHILE INKEY$ <> ""
WEND
SLEEP 4
END
ERRS:
CLS
SCREEN 0
PRINT "ERROR"
PRINT
PRINT "VGA AND MOUSE REQUIRED"
PRINT
PRINT
RESUME 99

DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0, 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1 , 30 , 0 ,0 , 0 , 0 , 0
DATA 3 , 3 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 12, 12 , 12 , 12 , 3 , 0 , 0 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 12 ,10 , 10 , 10 , 12 , 3
DATA 3 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 12 , 10 , 0 , 10 , 12, 3 , 14 , 3 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 12 , 10 , 0 , 10 ,12 , 3 , 14 , 14 , 3 , 0
DATA 1 , 1 , 1 , 1 , 30 , 0 , 0 , 3 , 12 , 10 , 10 , 10 , 12 , 13 , 3 , 14, 14 , 3 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 13 , 13 , 13 , 13 , 13 , 13 , 3, 14 , 14 , 3 , 1 , 0 , 0 , 0
DATA 0 , 0 , 0 , 3 , 13 , 13 , 13 , 13 , 13 , 13 , 3 , 14 , 14 , 3 , 1 , 0, 0 , 0 , 0 , 0 , 0 , 3 , 12 , 10 , 10 , 10 , 12 , 13 , 3 , 14 , 14 , 3 , 1, 0 , 0 , 0 , 0 , 0 , 0 , 3
DATA 12 , 10 , 0 , 10 , 12 , 3 , 14 , 14 , 3 , 0 , 1 , 1 , 1 , 1 , 30 , 0 ,0 , 0 , 12 , 10 , 0 , 10 , 12 , 3 , 14 , 3 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0, 0 , 0 , 12 , 10 , 10 , 10
DATA 12 , 3 , 3 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 12 , 12 ,12 , 12 , 3 , 0 , 0 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 3, 3 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0, 0 , 0 , 0 , 0 , 0 , 1 , 30 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,0 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0

SUB boombug
FOR BBB = 30 TO 1 STEP -1
  CIRCLE (ztx, zty), BBB, 100 + (1 + (BBB MOD 14))
  PAINT (ztx, zty), 100 + (1 + (BBB MOD 14)), 100 + (1 + (BBB MOD 14))
  SOUND 40 + (BBB * 10), 1
NEXT
dosdelay .5
FOR B = 2 TO 30
  CIRCLE (ztx, zty), B, B + 200
  PAINT (ztx, zty), 0, B + 200
NEXT
score = score + (200 - zty)
CLS
END SUB

DEFSNG A-Y
SUB dosdelay (seconds!)
DEF SEG = 0
d& = FIX(seconds! * 18.20444444#)
FOR t& = t& TO d&
  d% = PEEK(&H46C) AND 255
  WHILE d% = (PEEK(&H46C) AND 255)
  WEND
NEXT
END SUB

DEFINT A-Y
SUB FIRSTLOOP
DO
  X$ = INKEY$
  IF sss = 0 THEN
    SWAP s1, s2
    IF s1 = 0 THEN
      CALL getmxy(ODX, dy)
      CALL spidey
    END IF
  END IF
LOOP UNTIL DDX <> ODX OR ddy <> dy OR X$ <> "" OR mbtn% <> 0
END SUB

DEFINT Z
SUB getmxy (mx%, my%) STATIC
MOUSE 3, 0, X, y                                  ' get graphic coordinates
mx% = X / 2                                       ' (x / 8) + 1
my% = y                                           ' (y / 8) + 1   'convert to text coordinates
END SUB

SUB hidemouse STATIC
CALL MOUSE(2, 0, 0, 0)
END SUB

DEFSNG Z
SUB INITIAL
xu = (RND * 200) + 50
yu = (RND * 100) + 50
chk = INT(RND * 3)
SELECT CASE chk
  CASE 0
    chx = 1
    chy = 1
  CASE 1
    chx = -1
    chy = 1
  CASE 2
    chx = 1
    chy = -1
  CASE 3
    chx = -1
    chy = -1
END SELECT

END SUB

SUB loadbug
' can have more bugs left out so data files not needed
FOR X = 1 TO 18
  FOR y = 1 TO 18
    READ C
    sp(X, y) = C
  NEXT
NEXT
END SUB

DEFINT Z
SUB mborders (X, y, h, v) STATIC
MOUSE 7, 0, (X - 1) * 8, (h - 1) * 8
MOUSE 8, 9, (y - 1) * 8, (v - 1) * 8
END SUB

FUNCTION mbtn% STATIC
MOUSE 3, buttons, 0, 0
mbtn% = buttons
END FUNCTION

SUB MOUSE (m0%, m1%, m2%, m3%) STATIC
DIM inregs AS RegType, outregs AS RegType
inregs.ax = m0%
inregs.bx = m1%
inregs.cx = m2%
inregs.dx = m3%
CALL INTERRUPT(51, inregs, outregs)
m0% = outregs.ax
m1% = outregs.bx
m2% = outregs.cx
m3% = outregs.dx
END SUB

DEFSNG Z
SUB RULES
CLS
SCREEN 0
WIDTH 80, 25
COLOR 14
PRINT "             BUG SHOOT - BY ROUGE VALLEY SOFTWARE - COPYRIGHT 1997"
COLOR 10
PRINT "                        MOUSE REQUIRED  - VGA REQUIRED"
COLOR 12
PRINT "GAME PLAY:"
PRINT
PRINT "The bug bounces around the screen."
PRINT
PRINT "Move the mouse around the screen to determine where bomb is to travel to."
PRINT "Click the mouse button to launch bomb. Timing is the key to success."
PRINT
PRINT "If bomb blast touches the bug the bug explodes."
PRINT
PRINT "You have 10 turns."
PRINT
PRINT "Your score for each correct hit is determined by the hight of the bug."
PRINT "If the bug is right at the top of the screen you get 199 points."
PRINT "If the bug is right at the bottom of the screen you get 11 points, same as a"
PRINT "miss."
PRINT
PRINT "For each hit then, the score ranges from 11 to 199, in steps of 1."
PRINT "A perfect score would be 1990 points [never been done at high speed]."
PRINT ""
PRINT "ESCAPE [ESC] TO END PROGRAM                    [S] TO CHANGE SPEED"
COLOR 14
LOCATE 25, 1
PRINT "Press Any Key";
WHILE INKEY$ <> ""
WEND
DO
LOOP WHILE INKEY$ = ""
WHILE INKEY$ <> ""
WEND
CLS
SCREEN 13
END SUB

DEFINT Z
SUB setmxy (X, y) STATIC
MOUSE 4, 0, (X - 1) * 8, (y - 1) * 8
END SUB

SUB showmouse STATIC
MOUSE 1, 0, 0, 0
END SUB

SUB spidey
xc$ = INKEY$
WHILE INKEY$ <> ""
WEND
IF speed <> 1 THEN
  SELECT CASE speed
    CASE 2
      FOR a& = 1 TO 5000
      NEXT
    CASE 3
      FOR a& = 1 TO 10000
      NEXT
    CASE 4
      FOR a& = 1 TO 20000
      NEXT
    CASE 5
      FOR a& = 1 TO 40000
      NEXT
  END SELECT
END IF
xu = xu + chx
yu = yu + chy

FOR ys = 1 TO 18                                  ' put spidey
  FOR xs = 1 TO 18
    pc = POINT(xu + xs, yu + ys)
    IF pc = 200 THEN GOTO 66
    IF pc <> sp(xs, ys) THEN
      PSET (xu + xs, yu + ys), sp(xs, ys)
    END IF
66
  NEXT
NEXT
3
IF xu >= 300 THEN chx = 0 - chx
IF xu <= 0 THEN chx = ABS(chx)
IF yu >= 170 THEN chy = 0 - chy
IF yu <= 0 THEN chy = ABS(chy)
IF xc$ = CHR$(27) THEN END
END SUB

DEFSNG Z
SUB tit
VIEW
CLS
COLOR 7
PRINT ""
PRINT "           RVS BUG SHOOT"
PRINT ""
PRINT "          Copyright (1997)"
PRINT ""
PRINT "PROGRAM WAS CREATED WITH QUICK BASIC"
PRINT ""
PRINT "LEARN TO BE A BASIC PROGRAMMER"
PRINT ""
PRINT "A GREAT INTELLECTUAL HOBBY"
PRINT ""
PRINT ""
PRINT ""
PRINT "ROUGE VALLEY SOFTWARE"
PRINT "255 ROUGE HILLS DRIVE"
PRINT "SCARBOROUGH,  ONTARIO"
PRINT "CANADA        M1C 2Y9"
PRINT ""
PRINT "75504.2526@compuserve.com"
PRINT
RANDOMIZE TIMER
FOR ix = 0 TO 320
  FOR iy = 0 TO 200
    IF POINT(ix, iy) = 7 THEN PSET (ix, iy), 70 + (10 * RND)
  NEXT
NEXT
COLOR 11
CALL wwait
CLS
END SUB

SUB wwait
PRINT "Please Wait 5 Seconds ..."
t1& = TIMER
DO
  t2& = TIMER
  t3& = ABS(t1& - t2&)
  IF dud <> INT(t3&) THEN
    dud = INT(t3&)
    LOCATE 25, 37
    PRINT INT(t3&);
    SOUND 40 * (INT(t3&) + 1), 4
  END IF
LOOP UNTIL t3& >= 5
COLOR 14
LOCATE 24, 1
PRINT "Press Any Key";
WHILE INKEY$ <> ""
WEND
DO
LOOP WHILE INKEY$ = ""
WHILE INKEY$ <> ""
WEND

END SUB