Multiple key press player movement routine.

[Pete]

If you ever wanted to move a player in any direction by holding down the cursor arrow keys while still being able to process other events and even type other keys while still moving, this might be of interest to you.

Controls: (Hold down keys for perpetual movement.)
Right arrow = move right.
Left arrow = move left.
Up arrow = move up
Down arrow = move down... Duh, this sounds so stupid up to now, but wait...
Up arrow + left arrow = diagonal up and to the left.
Up arrow + right arrow = diagonal up and to the right.
Down arrow + left arrow = diagonal down and to the left.
Down arrow + right arrow = diagonal down and to the right.
Left ctrl + or without any arrow keys held and while or while not moving increases speed.
Left alt + or without any arrow keys held and while or while not moving decreases speed.
Type any key to print key character to the upper right screen while or while not moving.
space bar honks horn.
esc to quit.

An old problem with QBasic was not being able to detect more than two key presses. Special keys like ctrl, alt, and shift all had to be recognized with DEF SEG PEEK/POKE routines. (BTW - we can still use those PEKK/POKE (1046) routines in QB64.)

Anyway, here's the demo...

Code: (Select All)

' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
WIDTH 140, 42
_SCREENMOVE 0, 0
DIM move_speed AS DOUBLE
top = 2: bottom = _HEIGHT: left = 1: right = _WIDTH
PRINT "Press single or combo of arrow keys to move. Rt. Ctrl = faster / Rt. Alt = slower. "
LOCATE 2, 1: PRINT STRING$(_WIDTH, "_");
move_speed = 25
player_y = _HEIGHT \ 2 + 1: player_x = _WIDTH \ 2
LOCATE player_y, player_x: PRINT "*";
_KEYCLEAR
DO
    _LIMIT 60
    LOCATE 1, 50: PRINT "Movement y, x: "; mpy; mpx; "  Speed Delay ="; move_speed;

    ' If you only want speed changes when a player moves then remove the timer and move this routine to: IF move_player = -1 AND ABS(z1 - TIMER) > .07 THEN
    IF ABS(z3 - TIMER) > .1 THEN ' Check every .1 seconds for a speed change.
        IF _KEYDOWN(100307) AND move_speed < 50 THEN move_speed = move_speed + 1
        IF _KEYDOWN(100305) AND move_speed > 0 THEN move_speed = move_speed - 1
        z3 = TIMER
    END IF

    IF ABS(z2 - TIMER) > move_speed / 100 THEN ' Moving lag. Note: Division needed because computer math can't add decimal numbers correctly.
        IF move_player = 0 THEN
            IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) THEN ' Arrow keys.
                move_player = -1
                z1 = TIMER ' Delay timer for key lag.
            END IF
        END IF
    END IF

    IF move_player = -1 THEN
        IF ABS(z1 - TIMER) > .05 THEN ' Key lag. A slight delay to allow player to press two keys together within a reasonable amout of time.
            DO ' Falx loop to throw out illegal key combos like up + down.
                mpx = 0: mpy = 0

                ' Eliminate illegal combos.
                IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN move_player = 0: z2 = TIMER: EXIT DO
                IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN move_player = 0: z2 = TIMER: EXIT DO

                ' IF female THEN STOP AND GET #1, directions.
                IF _KEYDOWN(18432) THEN ' Up-arrow.
                    mpy = -1
                END IF
                IF _KEYDOWN(19712) THEN ' Right-arrow.
                    mpx = 1
                END IF
                IF _KEYDOWN(20480) THEN ' Down-arrow.
                    mpy = 1
                END IF
                IF _KEYDOWN(19200) THEN ' Left-arrow.
                    mpx = -1
                END IF

                IF mpx AND mpy THEN ' Routine to cancel keys as a double hold is being lifted. This allows for the difference of both keys cannot be released at exactly the same time.
                    combo = -1
                ELSE
                    IF combo THEN combo = 0: move_player = 0: EXIT DO
                END IF

                ' Move player
                IF player_y + mpy > top AND player_y + mpy <= bottom AND player_x + 2 * mpx > left AND player_x + 2 * mpx < right THEN
                    LOCATE player_y, player_x
                    PRINT " ";
                    player_y = player_y + mpy: player_x = player_x + 2 * mpx
                    LOCATE player_y, player_x
                    PRINT "*";
                ELSE
                    BEEP ' Hit the wall!
                END IF
                move_player = 0
                z2 = TIMER ' Timer for moving lag regulated by the move_speed variable.
                EXIT DO
            LOOP
        END IF
    ELSE ' If you want additional key routines, put them here...
        ky$ = INKEY$
        IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
            LOCATE 1, _WIDTH - 22: PRINT SPACE$(22);
            LOCATE 1, _WIDTH - 22
            PRINT "You pressed key: "; ky$;
            SELECT CASE ky$
                CASE CHR$(32) ' Space bar
                    BEEP
                CASE CHR$(27) ' Esc
                    END
            END SELECT
        END IF
    END IF
LOOP

Pete

[Pete]

I added a run and gun feature. The space bar can't be used, because of a QB64 bug, so I switched the fire key to TAB. It shoots up to 8 bullets PER direction. If you are fast enough, you can have 30 to 40 bullets going in multiple directions. Just use cursor key to switch directions while pressing the Tab key repeatedly. If _KEYDOWN were used, even more bullets would be possible but at some point, a game needs a bit of a challenge, so I used INKEY$ here, instead.

Code: (Select All)

' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
WIDTH 140, 42
_SCREENMOVE 0, 0
DIM SHARED top, bottom, left, right, m_fired
DIM SHARED m_max: m_max = 8
REDIM SHARED m_num(m_max), mx(m_max, 8), my(m_max, 8)
top = 2: bottom = _HEIGHT: left = 1: right = _WIDTH
PRINT "Press single or combo of arrow keys to move. Rt. Ctrl = faster / Rt. Alt = slower. "
LOCATE 2, 1: PRINT STRING$(_WIDTH, "_");
move_speed = 25
player_y = _HEIGHT \ 2 + 1: player_x = _WIDTH \ 2
LOCATE player_y, player_x: PRINT "*";
_KEYCLEAR
DO
    _LIMIT 60
    IF status% THEN CALL run_and_gun(status%, mpy, mpx, player_y, player_x)
    LOCATE 1, 50: PRINT "Movement y, x: "; mpy; mpx; "  Speed Delay ="; move_speed; " Fired ="; m_fired; " Status ="; status%

    ' If you only want speed changes when a player moves then remove the timer and move this routine to: IF move_player = -1 AND ABS(z1 - TIMER) > .07 THEN
    IF ABS(z3 - TIMER) > .1 THEN ' Check every .1 seconds for a speed change.
        IF _KEYDOWN(100307) AND move_speed < 50 THEN move_speed = move_speed + 1
        IF _KEYDOWN(100305) AND move_speed > 0 THEN move_speed = move_speed - 1
        z3 = TIMER
    END IF

    IF ABS(z2 - TIMER) > move_speed / 100 THEN ' Moving lag. Note: Division needed because computer math can't add decimal numbers correctly.
        IF move_player = 0 THEN
            IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) THEN ' Arrow keys.
                move_player = -1
                z1 = TIMER ' Delay timer for key lag.
            END IF
        END IF
    END IF

    IF move_player = -1 THEN
        IF ABS(z1 - TIMER) > .05 THEN ' Key lag. A slight delay to allow player to press two keys together within a reasonable amout of time.
            DO ' Falx loop to throw out illegal key combos like up + down.
                mpx = 0: mpy = 0

                ' Eliminate illegal combos.
                IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN move_player = 0: z2 = TIMER: EXIT DO
                IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN move_player = 0: z2 = TIMER: EXIT DO

                ' IF female THEN STOP AND GET #1, directions.
                IF _KEYDOWN(18432) THEN ' Up-arrow.
                    mpy = -1
                END IF
                IF _KEYDOWN(19712) THEN ' Right-arrow.
                    mpx = 1
                END IF
                IF _KEYDOWN(20480) THEN ' Down-arrow.
                    mpy = 1
                END IF
                IF _KEYDOWN(19200) THEN ' Left-arrow.
                    mpx = -1
                END IF

                IF mpx AND mpy THEN ' Routine to cancel keys as a double hold is being lifted. This allows for the difference of both keys cannot be released at exactly the same time.
                    combo = -1
                ELSE
                    IF combo THEN combo = 0: move_player = 0: EXIT DO
                END IF

                ' Move player
                IF player_y + mpy > top AND player_y + mpy <= bottom AND player_x + 2 * mpx > left AND player_x + 2 * mpx < right THEN
                    LOCATE player_y, player_x
                    PRINT " ";
                    player_y = player_y + mpy: player_x = player_x + 2 * mpx
                    LOCATE player_y, player_x
                    PRINT "*";
                ELSE
                    BEEP ' Hit the wall!
                END IF
                move_player = 0
                z2 = TIMER ' Timer for moving lag regulated by the move_speed variable.
                EXIT DO
            LOOP
        END IF
    ELSE ' If you want additional key routines, put them here...
        ky$ = INKEY$
        IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
            LOCATE 1, _WIDTH - 22: PRINT SPACE$(22);
            LOCATE 1, _WIDTH - 22
            PRINT "You pressed key: "; ky$;
            SELECT CASE ky$
                CASE CHR$(9) ' Tab key. Space bar will not register with arrow up + arrow left.
                    status% = -1
                CASE CHR$(27) ' Esc
                    END
            END SELECT
        END IF
    END IF
LOOP

SUB run_and_gun (status%, mpy, mpx, player_y, player_x)
    STATIC m_num(), my(), mx(), z4

    IF ABS(z4 - TIMER) > .04 THEN
        z4 = TIMER
        SELECT CASE status%
            CASE -1
                IF mpy = -1 AND mpx = 0 OR mpy = 0 AND mpx = 0 THEN ' Includes default fire up.
                    direction = 1
                ELSEIF mpy = -1 AND mpx = 1 THEN
                    direction = 2
                ELSEIF mpy = 0 AND mpx = 1 THEN
                    direction = 3
                ELSEIF mpy = 1 AND mpx = 1 THEN
                    direction = 4
                ELSEIF mpy = 1 AND mpx = 0 THEN
                    direction = 5
                ELSEIF mpy = 1 AND mpx = -1 THEN
                    direction = 6
                ELSEIF mpy = 0 AND mpx = -1 THEN
                    direction = 7
                ELSEIF mpy = -1 AND mpx = -1 THEN
                    direction = 8
                END IF

                IF m_num(direction) + 1 < m_max THEN
                    SOUND 900, .1
                    m_num(direction) = m_num(direction) + 1
                    my(m_num(direction), direction) = player_y
                    mx(m_num(direction), direction) = player_x
                    m_fired = m_fired + 1
                END IF
                status% = 1

            CASE 1
                FOR h = 1 TO 8 ' Check all directions.
                    IF m_num(h) > 0 THEN
                        j = m_num(h)
                        FOR i = 1 TO j
                            IF player_y = my(i, h) AND player_x = mx(i, h) THEN ELSE LOCATE my(i, h), mx(i, h): PRINT " ";
                            SELECT CASE h
                                CASE 1
                                    IF my(i, h) - 1 > top THEN
                                        my(i, h) = my(i, h) - 1
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 2
                                    IF my(i, h) - 1 > top AND mx(i, h) + 2 < right THEN
                                        my(i, h) = my(i, h) - 1
                                        mx(i, h) = mx(i, h) + 2
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 3
                                    IF mx(i, h) + 2 < right THEN
                                        mx(i, h) = mx(i, h) + 2
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 4
                                    IF my(i, h) + 1 < bottom AND mx(i, h) + 2 < right THEN
                                        my(i, h) = my(i, h) + 1
                                        mx(i, h) = mx(i, h) + 2
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 5
                                    IF my(i, h) + 1 < bottom THEN
                                        my(i, h) = my(i, h) + 1
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 6
                                    IF my(i, h) + 1 < bottom AND mx(i, h) - 2 > left THEN
                                        my(i, h) = my(i, h) + 1
                                        mx(i, h) = mx(i, h) - 2
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 7
                                    IF mx(i, h) - 2 > left THEN
                                        mx(i, h) = mx(i, h) - 2
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                                CASE 8
                                    IF my(i, h) - 1 > top AND mx(i, h) - 2 > left THEN
                                        my(i, h) = my(i, h) - 1
                                        mx(i, h) = mx(i, h) - 2
                                        LOCATE my(i, h), mx(i, h): PRINT ".";
                                    ELSE
                                        GOSUB remove_missile
                                    END IF
                            END SELECT
                        NEXT
                    END IF
                NEXT
                IF m_fired <= 0 THEN m_fired = 0: status% = 0 ' All missiles cleared.
        END SELECT
    END IF
    EXIT SUB

    remove_missile:
    m_num(h) = m_num(h) - 1
    FOR k = 1 TO m_num(h)
        my(k, h) = my(k + 1, h)
        mx(k, h) = mx(k + 1, h)
    NEXT
    m_fired = m_fired - 1
    RETURN
END SUB

Pete