Multiple key press player movement routine. - Pete - 10-02-2022
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
RE: Multiple key press player movement routine. - Pete - 10-02-2022
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
|