'===========================================================================
' Subject: BUG! (INTERESTING PUZZLE GAME)    Date: 07-20-99 (17:51)       
' Author:  Andre Dirk                        Code: QB, QBasic, PDS        
' Origin:  members.tripod.com/~qbsc/mainga Packet: GAMES.ABC
'===========================================================================
DECLARE SUB CHANGE ()
DECLARE SUB GET.LEVEL ()
DECLARE SUB SHOW.LEVEL ()
DECLARE SUB FLOOR (X%, Y%, T%)
DECLARE SUB MESSAGE (M$, OK$)
DECLARE SUB MILLIDELAY (msecs%)
DECLARE SUB BOX.BAR (X1%, Y1%, X2%, Y2%, COL1%, COL2%, CS%, WIDE%)
DECLARE FUNCTION MENU% (OPT$(), VALID%())
DECLARE FUNCTION GET.SIZE% (X1%, Y1%, X2%, Y2%)
DECLARE SUB BAR (X1%, Y1%, MIN.COL%, COLOURS%, H.OR.V%, W%, CS%)
DECLARE SUB WIDE.BAR (X1%, Y1%, MIN.COL%, COLOURS%, H.OR.V%, W%, CS%)
DEFINT A-Z
OPTION BASE 1

MILLIDELAY 0
SCREEN 13: CLS

DIM SHARED KP AS STRING
RESTORE COOD
READ Y
DIM SHARED COOD.Y(Y + 1) AS SINGLE
DIM SHARED COOD.X(Y + 1) AS SINGLE
DIM SHARED COOD.S(Y + 1)  AS SINGLE
FOR A = 1 TO Y + 1
READ COOD.X(A), COOD.S(A), COOD.Y(A)
NEXT A

COOD:
DATA 10
DATA 0  ,       32      ,       0
DATA 15 ,       29      ,       10
DATA 27 ,       26.5    ,       19
DATA 37 ,       24.5    ,       27
DATA 46 ,       22.75   ,       34
DATA 53 ,       21.5    ,       40
DATA 60 ,       20.25   ,       45
DATA 66 ,       19      ,       49
DATA 71 ,       18.1    ,       53
DATA 78 ,       17      ,       57
DATA 83 ,       16      ,       61

DIM M.MENU$(3), M.MENU.V(3)
M.MENU$(1) = "Start Game": M.MENU.V(1) = 1
M.MENU$(2) = "Help": M.MENU.V(2) = 1
M.MENU$(3) = "Quit": M.MENU.V(3) = 1

DIM SHARED LEVEL
DIM SHARED WORLD(0 TO 11, 0 TO 11)
DIM SHARED MTURNS: MTURNS = 100
DIM SHARED SPEED: SPEED = 20

DIM SHARED PX, PY, PS
LEVELS = 0
MAIN:
DO
FLOOR INT(RND * 10) + 1, INT(RND * 10) + 1, 6
KP = UCASE$(INKEY$)
LOOP WHILE KP = ""

MESSAGE "Bug! - By Andre' Dirk", "OK"

MAIN2:
IF LEVEL > LEVELS THEN LEVELS = LEVEL
LEVEL = 1
C = MENU(M.MENU$(), M.MENU.V())
SELECT CASE C
CASE 1
IF LEVELS > 1 THEN
DIM L$(LEVELS + 1), LV(LEVELS + 1)
FOR A = 1 TO LEVELS
L$(A) = "Level" + STR$(A): LV(A) = 1
NEXT A
L$(LEVELS + 1) = "Main Menu": LV(LEVELS + 1) = 1
C = MENU(L$(), LV())
SELECT CASE C
CASE 1 TO LEVELS: LEVEL = C
CASE ELSE: GOTO MAIN2
END SELECT
ERASE L$, LV
END IF
GOTO V.START
CASE 2
CLS
COLOR 11: LOCATE 1, 12: PRINT "Object of the game"
PRINT
COLOR 14: PRINT STRING$(40, CHR$(196))
COLOR 15: PRINT "You're the red square and you must touch"
PRINT "all of the green squares but be careful,"
PRINT "because the white squares can disappear."
PRINT "The yellow squares and the green squares"
PRINT "never disappear, so they are safe.      "
COLOR 14: PRINT STRING$(40, CHR$(196))
DO
FLOOR INT(RND * 10) + 1, INT(RND * 10) + 1, 6
KP = UCASE$(INKEY$)
LOOP WHILE KP = ""
CLS
COLOR 11: LOCATE 1, 16: PRINT "Controls"
PRINT
COLOR 14: PRINT STRING$(40, CHR$(196))
COLOR 15
PRINT "Up Arrow    - Move Away     P - Pause   "
PRINT "Down Arrow  - Move Towards  R - Restart "
PRINT "Left Arrow  - Move Left                 "
PRINT "Right Arrow - Move Right                "
PRINT "Escape      - Exit                      "
COLOR 14: PRINT STRING$(40, CHR$(196))
GOTO MAIN
CASE ELSE
MESSAGE "Bye for now!!", "??"
END
END SELECT

V.START:
IF LEVEL > 10 THEN MESSAGE "You won the game!", "??": LEVEL = 10: GOTO MAIN
TURNS = 0
GET.LEVEL
SHOW.LEVEL
PX = 1
PY = 1
PS = 0
MESSAGE "Now you begin Level" + STR$(LEVEL) + "!", "Ok"
START:
DO
DO
FLOOR PX, PY, 5
SELECT CASE WORLD(PX, PY)
CASE 4
WORLD(PX, PY) = 3: PS = PS + 1: PLAY "O4MBT255L64ABCDEFG"
IF PS = 4 THEN MESSAGE "You did it!!", "OK": LEVEL = LEVEL + 1: GOTO V.START
CASE 0, 1: MESSAGE "You fell off! - Try Again?", "Ok": GOTO V.START
END SELECT
MILLIDELAY SPEED
TURNS = TURNS + 1
IF TURNS > MTURNS THEN CHANGE: TURNS = 0
KP = UCASE$(INKEY$)
LOOP WHILE KP = ""
SELECT CASE KP
CASE CHR$(27): MESSAGE "Exit so soon? Yes!", "Ok": GOTO MAIN
CASE CHR$(0) + "P"
SELECT CASE WORLD(PX, PY - 1)
CASE 0, 1
CASE ELSE: FLOOR PX, PY, (WORLD(PX, PY)): PY = PY - 1
END SELECT

CASE CHR$(0) + "H"
SELECT CASE WORLD(PX, PY + 1)
CASE 0, 1
CASE ELSE: FLOOR PX, PY, (WORLD(PX, PY)): PY = PY + 1
END SELECT

CASE CHR$(0) + "K"
SELECT CASE WORLD(PX - 1, PY)
CASE 0, 1
CASE ELSE: FLOOR PX, PY, (WORLD(PX, PY)): PX = PX - 1
END SELECT

CASE CHR$(0) + "M"
SELECT CASE WORLD(PX + 1, PY)
CASE 0, 1
CASE ELSE: FLOOR PX, PY, (WORLD(PX, PY)): PX = PX + 1
END SELECT

CASE "P": MESSAGE "Game is paused...OK?", "No"
CASE "~": MESSAGE "You are cheat - Maybe?", "NO": LEVEL = LEVEL + 1: GOTO V.START
CASE "E": MESSAGE "Easy Mode Abounds?", "Yo": MTURNS = 120
CASE "N": MESSAGE "Normal Mode Abounds?", "Oi": MTURNS = 100
CASE "R": MESSAGE "Restart the level?", "OK": GOTO V.START
END SELECT

LOOP
L1:
DATA 3,2,2,2,3,3,1,1,1,3
DATA 1, , , , ,1, , , ,2
DATA 1, , , , ,1, , , ,2
DATA 1, , ,4, ,1, , , ,2
DATA 3,2,2,2,2,4, , , ,3
DATA 3, , , ,4,2,2,2,2,3
DATA 2, , , ,1, ,4, , ,1
DATA 2, , , ,1, , , , ,1
DATA 2, , , ,1, , , , ,1
DATA 3,1,1,1,3,3,2,2,2,3

L2:
DATA 2,4, ,4, ,4,1,3, ,4
DATA  ,2, ,1, , , ,1, ,2
DATA  ,2, ,1, ,2, ,1, ,2
DATA 3,2,3,1,3,2,3,1,3,2
DATA  , ,2, ,1, ,2, ,1,
DATA 1, ,2, , , ,2, ,1,
DATA 1,3,2,3,1,3,2,3,1,3
DATA  ,1, ,2, ,1, , , ,1
DATA  ,1, ,2, ,1, ,2, ,1
DATA 3,1,3,2,3,1,3,2,3,1

L3:
DATA  ,1,1,1,1,1,1,1,1,
DATA  ,1, , , ,3, , ,1,
DATA  ,3,2,2, , , ,3,1,
DATA  , , ,2, ,1,3,2,1,
DATA 2,3,1,2,3,4, , ,1,
DATA 2, ,1, ,1, , , ,1,
DATA 2,3,1,1,1,1,3, ,4,
DATA 2, , ,4, , ,2, , ,
DATA 2, , , , , ,2,4, ,
DATA 3,1,1,1,1,1,3, , ,

L4:
DATA 4,1,1,3, ,1,1,1,1,4
DATA 2, , ,3,2,3, , , ,
DATA 2,3,1,1, ,2, , , ,
DATA  , , ,1,3,2, , ,4,3
DATA 2,2,2,2,3,1,1,1,1,2
DATA 3, , , , , , , , ,2
DATA 1, ,3,1,1,1,1,3, ,2
DATA 1, ,2, ,3,2,2,3, ,3
DATA 1,2,2, ,1,1,1,1,3,1
DATA 3,2, ,4,2,2,2,3, ,

L5:
DATA 3,1,1,1,1,4,1,1,1,3
DATA 1, , , , ,2, , , ,1
DATA 3,2,3,2,2,2,2,3,2,3
DATA 1, ,2, , ,2, ,2, ,1
DATA 1, ,2, ,3,3,4,2, ,1
DATA 1, ,2, ,1,2,1,2, ,1
DATA 1, ,4, ,1,4,1,2, ,1
DATA 1, ,2,1,1,2,3,3, ,1
DATA 1, ,2, ,1, ,1, , ,1
DATA 3,2,3, ,3,1,1,1,1,3

L6:
DATA 3,2,2,2,2,1,1,1,1,3
DATA 2,1,1,1,2,1,2,2,2,1
DATA 2,1,4,1,2,1,2,2,2,1
DATA 2,1, ,2,2,1,2,4,2,1
DATA 2,1,2,1,3,1,2,1,2,1
DATA 2,1,2,1,2,3,2,1,2,1
DATA 2,1,4,1,2,1,1, ,2,1
DATA 2,1,1,1,2,1,2,4,2,1
DATA 2,1,1,1,2,1,2,2,2,1
DATA 3,2,2,2,2,2,1,1,1,3

L7:
DATA 3,2,2, , , , , ,2,4
DATA 1, ,2, ,2,2,3, ,2,
DATA 1, ,2, ,2, ,2, ,2,
DATA 1, ,3,2,2, ,2,2,2,
DATA 1, ,2, , , ,2, , ,4
DATA 1, ,2, ,3,2,2,2,2,1
DATA 1, ,2, ,2,1,1,1,2,1
DATA 1, ,2, ,2,1,4,1,2,1
DATA 1, ,2, ,2,1, , ,3,1
DATA 3, ,4,2,2,1,1,1,1,

L8:
DATA 3,1,1,1,1,1,1,1,4,
DATA 1,4,2,2,2,2,2,3,1,
DATA 1,2,3,1,1,1, ,2,1,
DATA 1,1,1,1,2,1,3,2,1,
DATA  , , ,3,2,2,2,2,3,
DATA 1,1,1,1,1,1,1,1,1,
DATA 1,2,2,2,2,2,2,2,2,3
DATA 1,2, ,3, ,1, ,1, ,1
DATA 1,2, , , ,4, ,1, ,1
DATA 3,2,1,4,1,1,1,1,1,1

L9:
DATA 1,2,1,2,1,2,1,2,2,4
DATA 2,1,4,1,1,1,3,1,2,1
DATA 1,2,2,2,1,2,2,2,2,1
DATA 4,2,2,1,2,1,2,1,4,1
DATA 1,2,1,3,2,2,2,2,1,1
DATA 2,1,2,1,2,1,2,1,2,1
DATA 1,2,1,1,1,2,2,2,1,3
DATA 2,1,2,1,2,1,3,1,2,2
DATA 1,2,1,1,1,1,1,2,1,2
DATA 3,1,1,1,2,1,1,1,3,2

L10:
DATA 2,2,2,3, , , ,1,2,
DATA 2, , ,1, , ,1,2,1,
DATA 2,2,2,1,1,4,1,1,2,
DATA 2,4, ,1, ,1,1,2,1,
DATA 2,2,2,1, , ,1,1,2,
DATA 1,1,1,3,2,2,3,2,1,
DATA 1,4,1, ,2, ,2,1,2,
DATA 1,1,1,3,2,4,2,2,1,
DATA 1, ,1, ,2,2, ,1,2,
DATA 3, , , , , , ,2,1,

DATA  , , , , , , , , ,

SUB BAR (X1, Y1, MIN.COL, COLOURS, H.OR.V, W, CS)

H = 0
V = 1

X = X1: Y = Y1

FOR COL = MIN.COL TO COLOURS STEP CS
SELECT CASE H.OR.V
CASE H
LINE (X, Y)-(X + (W - 1), Y), COL
Y = Y + 1
CASE ELSE
LINE (X, Y)-(X, Y + (W - 1)), COL
X = X + 1
END SELECT

NEXT COL
END SUB

SUB BOX.BAR (X1, Y1, X2, Y2, COL1, COL2, CS, WIDE)

IF WIDE THEN
SELECT CASE SGN(COL2 - COL1)
CASE -1: WID = (COL1 - COL2) - -1
CASE 1: WID = (COL2 - COL1) - -1
END SELECT

WIDE.BAR X1, Y1, COL1, COL2, 1, Y2 - Y1, CS
WIDE.BAR X1, Y2 - (WID * 2), COL1, COL2, 0, X2 - X1, CS
WIDE.BAR X1, Y1, COL1, COL2, 0, X2 - X1, CS
WIDE.BAR X2 - (WID * 2), Y1, COL1, COL2, 1, Y2 - Y1, CS
ELSE
SELECT CASE SGN(COL2 - COL1)
CASE -1: WID = (COL1 - COL2) - -1
CASE 1: WID = (COL2 - COL1) - -1
END SELECT
BAR X1, Y1, COL1, COL2, 1, Y2 - Y1, CS
BAR X1, Y2 - WID, COL1, COL2, 0, X2 - X1, CS
BAR X1, Y1, COL1, COL2, 0, X2 - X1, CS
BAR X2 - WID, Y1, COL1, COL2, 1, Y2 - Y1, CS
END IF
END SUB

SUB CHANGE
FOR X = 1 TO 10
FOR Y = 1 TO 10
SELECT CASE WORLD(X, Y)
CASE 1: WORLD(X, Y) = 2
CASE 2: WORLD(X, Y) = 1
END SELECT
NEXT Y
NEXT X
SHOW.LEVEL
PLAY "O3MBT255L64ABCDEFG"
END SUB

SUB FLOOR (X, Y, T)
BX1 = COOD.X(Y) + ((X - 1) * COOD.S(Y))
BX2 = COOD.X(Y) + ((X) * COOD.S(Y))
TX1 = COOD.X(Y + 1) + ((X - 1) * COOD.S(Y + 1))
TX2 = COOD.X(Y + 1) + ((X) * COOD.S(Y + 1))
BY = (149) - COOD.Y(Y)
TY = (149) - COOD.Y(Y + 1)

SELECT CASE T
CASE 0, 1: GOTO EEND1
CASE 2: COLOR 15
CASE 3: COLOR 14
CASE 4: COLOR 10
CASE 5: COLOR 12

CASE 6: COLOR INT(RND * 15) + 1

END SELECT

LINE (BX1, BY)-(BX2, BY)
LINE (BX1, BY)-(TX1, TY + 1)
LINE (BX2, BY)-(TX2 + 1, TY + 1)
LINE (TX1, TY + 1)-(TX2 + 1, TY + 1)

EEND1:
END SUB

SUB GET.LEVEL
SELECT CASE LEVEL
CASE 1: RESTORE L1
CASE 2: RESTORE L2
CASE 3: RESTORE L3
CASE 4: RESTORE L4
CASE 5: RESTORE L5
CASE 6: RESTORE L6
CASE 7: RESTORE L7
CASE 8: RESTORE L8
CASE 9: RESTORE L9
CASE 10: RESTORE L10
END SELECT

CLS
FOR Y = 10 TO 1 STEP -1
FOR X = 1 TO 10
READ WORLD(X, Y)
NEXT X
NEXT Y

END SUB

FUNCTION GET.SIZE (X1, Y1, X2, Y2)
GET.SIZE = 4 + INT(((PMAP(X2, 0) - PMAP(X1, 0) + 1) * (8) + 7) / 8) * 1 * (PMAP(Y2, 1) - PMAP(Y1, 1) + 1)
END FUNCTION

FUNCTION MENU (OPT$(), VALID())

VCOL = 14
NCOL = 112
BCOL = 159
SBARCOL = 9

OPTIONS = UBOUND(OPT$)

MAX.LEN = 0

FOR A = 1 TO OPTIONS
IF LEN(OPT$(A)) > MAX.LEN THEN MAX.LEN = LEN(OPT$(A))
NEXT A

XWIDTH = (MAX.LEN + 2) * 8
YWIDTH = (OPTIONS + 2) * 8

DIM TMP(GET.SIZE(0, 0, XWIDTH, YWIDTH))
DIM SBAR(GET.SIZE(0, 0, MAX.LEN * 8, 7))
GET (0, 0)-(XWIDTH, YWIDTH), TMP
LINE (0, 0)-(MAX.LEN * 8, 7), SBARCOL, BF
GET (0, 0)-(MAX.LEN * 8, 7), SBAR

LINE (0, 0)-(XWIDTH, YWIDTH), 0, BF
BOX.BAR 0, 0, XWIDTH, YWIDTH, 24, 26, 1, 1
LINE (6, 6)-(XWIDTH - 7, YWIDTH - 7), BCOL, B
LINE (0, 0)-(XWIDTH, YWIDTH), BCOL, B

FOR A = 1 TO OPTIONS
IF VALID(A) THEN COLOR VCOL ELSE COLOR NCOL
LOCATE A + 1, 2: PRINT OPT$(A)
NEXT A

ROW = 1

DO
IF ROW < 1 THEN ROW = OPTIONS
IF ROW > OPTIONS THEN ROW = 1
PUT (8, (ROW * 8)), SBAR
DO

KP = UCASE$(INKEY$)

LOOP WHILE KP = ""

PUT (8, (ROW * 8)), SBAR:
SELECT CASE KP
CASE CHR$(27): ROW = 0: EXIT DO
CASE CHR$(13), "5", " ": IF VALID(ROW) THEN EXIT DO
CASE CHR$(0) + "H", "8": ROW = ROW - 1
CASE CHR$(0) + "P", "2": ROW = ROW + 1
CASE CHR$(0) + "K", "4": ROW = ROW - 1
CASE CHR$(0) + "M", "6": ROW = ROW + 1
END SELECT

LOOP

PUT (0, 0), TMP, PSET
MENU = ROW
END FUNCTION

SUB MESSAGE (M$, OK$)

L = LEN(M$)
MaxCol = 40
 COL = MaxCol \ 2

C1 = ((COL - L / 2) - 2) + .5: C2 = C1 + (L + 3)

DIM TMP(1 TO GET.SIZE(((C1 - 1) * 8), (10 - 1) * 8, (C2 * 8), (16 - 1) * 8))
GET (((C1 - 1) * 8), (10 - 1) * 8)-((C2 * 8), (16 - 1) * 8), TMP
LINE (((C1 - 1) * 8), (10 - 1) * 8)-((C2 * 8), (16 - 1) * 8), 0, BF
BOX.BAR ((C1 - 1) * 8), (10 - 1) * 8, (C2 * 8), (16 - 1) * 8, 24, 26, 1, 1
COLOR 11
LOCATE 11, COL - L / 2 + .5: PRINT M$

BOX.BAR ((19 - 1) * 8), (12 - 1) * 8, (23 - 1) * 8, 14 * 8, 26, 28, 1, 1
COLOR 14: LOCATE 13, 20: PRINT OK$

DO
KP = UCASE$(INKEY$)
LOOP UNTIL KP = CHR$(13)

BOX.BAR ((19 - 1) * 8), (12 - 1) * 8, (23 - 1) * 8, 14 * 8, 34, 36, 1, 1
COLOR 10: LOCATE 13, 20: PRINT OK$

MILLIDELAY 1000 / 4
PUT (((C1 - 1) * 8), (10 - 1) * 8), TMP, PSET

END SUB

SUB MILLIDELAY (msecs) STATIC

    IF sysfact& THEN                             'calc- system speed yet?
        IF msecs THEN                            'have to want a delay
            count& = (sysfact& * msecs) \ -54    'calc- # of loops needed
            DO
                count& = count& + 1              'negative - add to get to 0
                IF count& = z THEN EXIT DO       'when its 0 we're done
            LOOP UNTIL t2 = PEEK(&H6C)           'make it the same as below
        END IF
    ELSE                                         'calc- system speed
        DEF SEG = &H40                           'point to low memory
        t1 = PEEK(&H6C)                          'get tick count
        DO
            t2 = PEEK(&H6C)                      'get tick count
        LOOP UNTIL t2 <> t1                      'wait 'til its a new tick
        DO
            sysfact& = sysfact& + 1              'count number of loops
            IF sysfact& = z THEN EXIT DO         'make it the same as above
        LOOP UNTIL t2 <> PEEK(&H6C)              'wait 'til its a new tick
        t2 = 256                                 'prevent the above UNTIL
    END IF
END SUB

SUB SHOW.LEVEL
CLS
FOR X = 1 TO 10
FOR Y = 1 TO 10
FLOOR X, Y, WORLD(X, Y)
NEXT Y
NEXT X
END SUB

SUB WIDE.BAR (X1, Y1, MIN.COL, COLOURS, H.OR.V, W, CS)

XP = X1: YP = Y1

SELECT CASE SGN(COLOURS - MIN.COL)
CASE -1
CSTEP1 = ((ABS(CS)) - (ABS(CS) * 2))
CSTEP2 = ABS(CS)
IF H.OR.V = 1 THEN XP = X1 + ((MIN.COL - COLOURS) + 1) ELSE YP = Y1 + ((MIN.COL - COLOURS) + 1)
CASE ELSE
CSTEP2 = ((ABS(CS)) - (ABS(CS) * 2))
CSTEP1 = ABS(CS)
IF H.OR.V = 1 THEN XP = X1 + ((COLOURS - MIN.COL) + 1) ELSE YP = Y1 + ((COLOURS - MIN.COL) + 1)
END SELECT

BAR X1, Y1, MIN.COL, COLOURS, H.OR.V, W, CSTEP1
BAR XP, YP, COLOURS, MIN.COL, H.OR.V, W, CSTEP2

END SUB