Weekly Qbasic and Qb64 Lesson Topics

DEFINT A-Z
gamescreen& = _NEWIMAGE(800, 600, 32)
SCREEN gamescreen&

PRINT "Welcome to Catch the Bunny, use arrow keys move hawk"
PRINT "Mouse works , left button capture , right button release"
PRINT " Ctrl key captures, alt key releases, try to drop the bunny into the nest"
PRINT "if you get him lined up just right he will not fall back to the ground."
PRINT " Hit any key to start"
PRINT "Escape key to quit"

'* constants relating to current bunny state -- easier than remembering numbers!
CONST BunnyStateNormal = 1
CONST BunnyStateCaptured = 2
CONST BunnyStateReleased = 3
CONST BunnyMaxRangeY = 550
limitfps% = 32
bunnymaxsp% = 100 * limitfps% '*pixels/sec
bunnydirection% = 1
bunnyspeed% = bunnymaxsp% / limitfps%
BunnyWidth% = 16
BunnyHeight% = 16
Background& = _LOADIMAGE("Hawksnest.bmp") 'create the background page


'Create the Hawk and rabbit sprites from data.
CreateSpriteFromData Hawk&, 23, 23
CreateSpriteFromData Bunny&, 16, 16

'------ The source co-ordinates for putimages ----------------------------------------
bwidth& = _WIDTH(Bunny&)
bheight& = _HEIGHT(Bunny&)
sbx1 = 0: sby1 = 0: sbx2 = bwidth& - 1: sby2 = bheight& - 1
hwidth& = _WIDTH(Hawk&)
hheight& = _HEIGHT(Hawk&)
shx1 = 0: shy1 = 0: shx2 = hwidth& - 1: shy2 = hheight& - 1
'-------------------------------------------------------------------------------------

DIM HawkX AS INTEGER, HawkY AS INTEGER
DIM BunnyX AS INTEGER, BunnY AS INTEGER

'* in the same order as unseenmachine's MOUSE record type
DIM Mx AS INTEGER '* current mouse cursor x
DIM My AS INTEGER '* current mouse cursor y
DIM LMB AS INTEGER '* current mouse left button pressed
DIM RMB AS INTEGER '* current mouse right button pressed
DIM MWH AS INTEGER '* current mouse wheel accumulator
'*********

bunnystart# = TIMER(.001)
bunnydirection% = 1
hawkdirection% = 1 '<-- added this
BunnyStartx% = 0
RabbitState% = BunnyStateNormal '* 1<-- added this
Capture = 0 '<-- added this
Release = 0 '<-- added this
BunnyY = BunnyMaxRangeY '<-- added this
Pink& = _RGB32(255, 0, 255) '<-- added this
'_MOUSEHIDE '* don't show the mouse cursor For slow mouse you need to see the mouse cursor

Dummy$ = INPUT$(1)
_FULLSCREEN
DO
   
    GetMouse Mx, My, LMB, RMB, MWH
    '********************************************************
    'rabbit state
    SELECT CASE RabbitState%
        CASE BunnyStateNormal '* normal
            IF BunnyX >= _WIDTH(0) - BunnyWidth% * 2 THEN '* BunnyWidth% is width of bunny image
                bunnydirection% = -bunnydirection%
                BunnyStartx% = BunnyX - 1
                bunnystart# = TIMER(.001)
            ELSEIF BunnyX < 0 THEN 'heading east
                bunnydirection% = -bunnydirection%
                BunnyStartx% = BunnyX + 1
                bunnystart# = TIMER(.001)
            END IF
            BunnyX = BunnyStartx% + bunnydirection% * bunnyspeed% * (TIMER(.001) - bunnystart#)
        CASE BunnyStateCaptured '* captures
            BunnyX = HawkX + Xdifference + 14: BunnyY = HawkY + bheight& + Ydifference + bheight&
        CASE BunnyStateReleased '* released
            BunnyY = BunnyY + 2
            IF BunnyX >= 40 AND BunnyX <= 55 THEN
                IF BunnyY >= 240 AND BunnyY <= 246 THEN
                    _DELAY 1
                    Capture = 0: Release = 0: RabbitState% = 1
                    bunnystart# = TIMER(.001)
                    bunnydirection% = 1
                    BunnyStartx% = 0
                    BunnyY = 550
                END IF
            END IF
            IF BunnyY >= 550 THEN
                BunnyY = 550
                Capture = 0: Release = 0: RabbitState% = 1
                bunnystart# = TIMER(.001)
                bunnydirection% = 1
                BunnyStartx% = 0
            END IF
    END SELECT
    '********************************************************
    'Keyboard/Mouse input here to update hawk posisiton
    'Slow the Mouse routine,have to show the mouse cursor for this to work
      GetMouse miceX, miceY, HawkLmb, hawkRmb, hawkWheel
      IF HawkX > miceX THEN HawkX = HawkX - 4: hawkdirection% = -1 'make them 8 for faster movement
      IF HawkX < miceX THEN HawkX = HawkX + 4: hawkdirection% = 1
      IF HawkY > miceY THEN HawkY = HawkY - 4
      IF HawkY < miceY THEN HawkY = HawkY + 4 'make them 2 for less movement


    '* changed from non-executed code -- acted funny with mouse (not anymore using sdl_warpmouse)
    IF _KEYDOWN(20480) THEN HawkY = HawkY + 4 'down arrow key
    IF _KEYDOWN(18432) THEN HawkY = HawkY - 4 'up arrow key
    IF _KEYDOWN(19200) THEN '                  left arrow key
        HawkX = HawkX - 4: hawkdirection% = -1
        HawkControlPressed% = 1
    END IF
    IF _KEYDOWN(19712) THEN '                  right arrow key
        HawkX = HawkX + 4: hawkdirection% = 1
        HawkControlPressed% = 1
    END IF


    BunnycentreX% = BunnyX + bwidth&
    BunnycentreY% = BunnyY + bheight&

    IF _KEYDOWN(100305) OR _KEYDOWN(100306) OR HawkLmb THEN 'control keys + Lmice button=capture
        IF RabbitState% = 1 THEN
            IF HawkX + 14 <= BunnycentreX% AND HawkX + 30 >= BunnycentreX% THEN
                IF HawkY + 30 <= BunnycentreY% AND HawkY + 40 >= BunnycentreY% THEN
            PLAY "mb a10b10g10"
                    Capture = 1: RabbitState% = 2
                    Xdifference = HawkX - BunnyX: Ydifference = HawkY - BunnyY
                END IF
            END IF
        END IF
    END IF
    IF _KEYDOWN(100307) OR _KEYDOWN(100308) OR hawkRmb THEN 'alternate keys + Rmice button=release
        IF RabbitState% = 2 THEN
        PLAY "mb a10g10e10g10a10ba"
                Release = 1: Capture = 0: RabbitState% = 3
        END IF
    END IF
    IF _KEYDOWN(32) THEN Debug = 1 ELSE Debug = 0 'used to show boundary box (collision test)
    '********************************************************
    'Hawk top and side collision tests
    IF HawkX >= _WIDTH(0) - (hwidth& * 2) THEN
        HawkX = _WIDTH(0) - (hwidth& * 2)
    ELSEIF HawkX < 0 THEN
        HawkX = 1
    END IF
    IF HawkY >= _HEIGHT(0) - (hheight& * 2) THEN
        HawkY = _HEIGHT(0) - (hheight& * 2)
    ELSEIF HawkY < 0 THEN
        HawkY = 1
    END IF

    '********************************************************
    'Draw a background
    _PUTIMAGE , Background&, 0

    'Draw the rabbit
    IF bunnydirection% = 1 THEN
        _PUTIMAGE (BunnyX, BunnyY)-(BunnyX + 31, BunnyY + 31), Bunny&, 0, (sbx1, sby1)-(sbx2, sby2)
    ELSE
        _PUTIMAGE (BunnyX, BunnyY)-(BunnyX + 31, BunnyY + 31), Bunny&, 0, (sbx2, sby1)-(sbx1, sby2)
    END IF

    'Draw the hawk
    IF hawkdirection% = 1 THEN
        _PUTIMAGE (HawkX, HawkY)-(HawkX + (hwidth& * 2) - 1, HawkY + (hheight& * 2) - 1), Hawk&, 0, (shx1, shy1)-(shx2, shy2)
    ELSE
        _PUTIMAGE (HawkX, HawkY)-(HawkX + (hwidth& * 2) - 1, HawkY + (hheight& * 2) - 1), Hawk&, 0, (shx2, shy1)-(shx1, shy2)
    END IF
    IF Debug = 1 THEN LINE (HawkX + 14, HawkY + 32)-(HawkX + 30, HawkY + 36), Pink&, B

    _DISPLAY
    _LIMIT limitfps%
    CLS

LOOP UNTIL _KEYDOWN(27)
SLEEP
SCREEN 0
_FREEIMAGE Bunny&
_FREEIMAGE Hawk&
_FREEIMAGE Background&
_FREEIMAGE gamescreen&
SYSTEM

'----------------------------------------------- SUBS ------------------------------------------------------------------------
SUB CreateSpriteFromData (ImageHandle&, XSize%, YSize%)
'// Store the current DESTintation in a LONG handle so we can restore it later.
OldDest& = _DEST

'// Create a new 32 bit image.
ImageHandle& = _NEWIMAGE(XSize%, YSize%, 32)

'//Change the DESTination to the new image.
_DEST ImageHandle&
FOR YP% = 0 TO YSize%
    FOR XP% = 0 TO XSize%
        '// Read the color value for the pixel.
        READ Sprite%
        IF Sprite% > 0 THEN
            IF Sprite% = 8 THEN clr& = _RGB(240, 120, 120)
            IF Sprite% = 15 THEN clr& = _RGB(255, 255, 255)
            '// PSET the color onto the newimage
            PSET (XP%, YP%), clr&
        END IF
    NEXT
NEXT
'// Restore the original destination.
_DEST OldDest&
END SUB

SUB GetMouse (GetMouseMx%, GetMousemy%, GetMouseLMB%, GetMouseRMB%, GetMouseMWH%)
'* this method is the most accurate way to read the mouse i know -- always guaranteed to make at least one read of the mouse
DO
    GetMouseMx% = _MOUSEX
    GetMousemy% = _MOUSEY
    GetMouseLMB% = _MOUSEBUTTON(1)
    GetMouseRMB% = _MOUSEBUTTON(2)
    GetMouseMWH% = _MOUSEWHEEL
LOOP WHILE _MOUSEINPUT
END SUB

' Bitmap for the Hawk sprite
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
DATA 8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,8,8,8,8,8
DATA 0,0,8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,8,8,8,8,8,0,0
DATA 0,0,0,0,0,8,8,8,8,0,0,0,0,0,0,0,8,8,8,8,0,0,0,0
DATA 0,0,0,0,0,0,8,8,8,8,8,8,0,0,8,8,8,8,8,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,8,8,8,8,8,8,8,8,8,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,8,8,8,8,8,8,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,8,8,8,8,8,8,8,8,8,0,0,0,0,0,0,0,0
DATA 8,8,8,8,8,8,8,8,8,8,8,8,8,8,1,8,0,0,0,0,0,0,0,0
DATA 0,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,0,0,0,0,0,0,0,0
DATA 0,0,8,8,8,8,0,8,8,8,8,8,8,8,8,8,8,0,0,0,0,0,0,0
DATA 0,0,8,8,0,0,0,8,8,8,8,8,8,0,0,0,8,0,0,0,0,0,0,0
DATA 0,0,8,0,0,0,0,8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,8,8,8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,8,8,0,0,0,8,8,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,8,0,0,8,0,0,8,0,8,0,0,0,0,0,0,0,0
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
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
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
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
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
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
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

' Bitmap for the Bunny sprite
DATA 0,0,0,0,0,15,0,0,0,0,15,0,0,0,0,0,0
DATA 0,0,0,0,0,15,15,0,0,15,15,0,0,0,0,0,0
DATA 0,0,0,0,0,0,15,0,0,0,15,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,15,15,15,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,15,15,15,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,15,0,15,0,15,0,0,0,0,0,0
DATA 0,0,0,0,0,0,15,15,15,15,15,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,15,15,15,15,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,15,15,15,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,15,15,15,15,15,0,0,0,0,0
DATA 0,0,0,0,0,0,15,15,15,15,15,15,0,0,0,0,0
DATA 0,0,0,0,0,15,0,15,15,15,15,0,15,0,0,0,0
DATA 0,0,0,0,0,0,0,0,15,15,15,15,0,0,0,0,0
DATA 0,0,0,0,0,0,15,15,0,0,0,0,15,15,0,0,0
DATA 0,0,0,15,15,15,0,0,0,0,0,0,15,15,15,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0