Weekly Qbasic and Qb64 Lesson Topics
March 28, 2024, 06:29:39 am
Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
News: Want to see a specific Tutorial? ASK!
 
  Home Help Search Arcade Links Staff List Login Register  

PacMan2f This one moves with arrow keys

Pages: 1 2 [3] 4
  Print  
Author Topic: PacMan2f This one moves with arrow keys  (Read 3612 times)
guest
Guest
« Reply #30 on: April 03, 2011, 01:36:45 pm »


    Here's an update showing PacMan responding to key movement and correct facing direction.
Code:
REM Demo of Pac Map and PacMan movement.
DEFLNG A-Z

Graphics& = _LOADIMAGE("GMPacMan1.bmp", 32)
SCREEN _NEWIMAGE(800, 600, 32) 'what we see

DIM SHARED mx, my, mbl, mbr
DIM SHARED PacMap(19, 25)
DIM SHARED Pacrow, Paccol, Pacsym, N, S, E, W, NN, SS, EE, WW

Pacsym = 10: Pacrow = 1: Paccol = 7: Pacframe = 1: PacDir = 2 'east
GOSUB Filldim
GOSUB Placepac
'NOTE row and column start at 0


DO
  _LIMIT 15
  CLS
  GOSUB Showmap
  GOSUB Movpac
  LOCATE 33, 1: PRINT Pacrow, Paccol, N, E, S, W
  LOCATE 34, 1: PRINT NN, EE, SS, WW
  Pacframe = Pacframe + 1
  IF Pacframe >= 5 THEN Pacframe = 1
  _DISPLAY
LOOP UNTIL _KEYDOWN(27)
SLEEP
SCREEN 0
SYSTEM

Movpac:
'make a backup of PAC row and column
OlDPacrow = Pacrow: OldPaccol = Paccol

'we need to know what is above,below,to right and left for possible unblocked movement
'if any of NSEW is a limit on the map make it invalid as -1
N = Pacrow - 1
IF N < 0 THEN N = -1
S = Pacrow + 1
IF S > 18 THEN S = -1
E = Paccol + 1
IF E > 24 THEN E = -1
W = Paccol - 1
IF W < 0 THEN W = -1

'now if NSEW are valid see whats in those "cells"
IF N <> -1 THEN NN = PacMap(N, Paccol)
IF S <> -1 THEN SS = PacMap(S, Paccol)
IF E <> -1 THEN EE = PacMap(Pacrow, E)
IF W <> -1 THEN WW = PacMap(Pacrow, W)

IF _KEYDOWN(20480) THEN 'down arrow key
  IF SS <> 176 THEN 'test for wall
    IF S <> -1 THEN 'test for map limit
      Pacrow = Pacrow + 1
      PacDir = 3 'south
    END IF
  END IF
END IF

IF _KEYDOWN(18432) THEN 'up arrow key
  IF NN <> 176 THEN
    IF N <> -1 THEN
      Pacrow = Pacrow - 1
      PacDir = 1 'north
    END IF
  END IF
END IF

IF _KEYDOWN(19200) THEN 'left arrow key
  IF WW <> 176 THEN
    IF W <> -1 THEN
      Paccol = Paccol - 1
      PacDir = 4 'west
    END IF
  END IF
END IF

IF _KEYDOWN(19712) THEN 'right arrow key
  IF EE <> 176 THEN
    IF E <> -1 THEN
      Paccol = Paccol + 1
      PacDir = 2 'east
    END IF
  END IF
END IF
IF Pacrow <> OlDPacrow OR Paccol <> OldPaccol THEN
  'remove pac man from old position
  z = PacMap(OlDPacrow, OldPaccol) ''extract old pac man
  z = z - Pacsym ''suntract pacman symbol from it (42 -  10 = 32)
  PacMap(OlDPacrow, OldPaccol) = z ''place z  back inside map

  'add new pac to new position
  z = PacMap(Pacrow, Paccol) ''extract whats at this new row and column (should be 32)
  z = z + Pacsym ''add pacman symbol to it (32 +10 = 42)
  PacMap(Pacrow, Paccol) = z ''place in back inside map
END IF
RETURN

Showmap:
FOR c = 0 TO 18
  FOR R = 0 TO 24
    z = PacMap(c, R)
    SELECT CASE z
      CASE 32

      CASE 42
        SELECT CASE PacDir
          CASE 1 'N
            SELECT CASE Pacframe
              CASE 1
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (164, 285)-(203, 246)
              CASE 2
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (205, 285)-(244, 246)
              CASE 3
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (246, 285)-(285, 246)
              CASE 4
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (287, 285)-(326, 246)
            END SELECT
          CASE 2 'E
            SELECT CASE Pacframe
              CASE 1
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (0, 246)-(39, 285)
              CASE 2
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (41, 246)-(80, 285)
              CASE 3
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (82, 246)-(121, 285)
              CASE 4
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (123, 246)-(162, 285)
            END SELECT
          CASE 3 'S
            SELECT CASE Pacframe
              CASE 1
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (164, 246)-(203, 285)
              CASE 2
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (205, 246)-(244, 285)
              CASE 3
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (246, 246)-(285, 285)
              CASE 4
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (287, 246)-(326, 285)
            END SELECT
          CASE 4 'W
            SELECT CASE Pacframe
              CASE 1
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (39, 246)-(0, 285)
              CASE 2
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (80, 246)-(41, 285)
              CASE 3
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (121, 246)-(82, 285)
              CASE 4
                _PUTIMAGE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), Graphics&, 0, (162, 246)-(123, 285)
            END SELECT

        END SELECT
      CASE 176
        LINE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), _RGB32(0, 0, 255), BF
    END SELECT

  NEXT R
NEXT c

RETURN

Filldim:
FOR c = 0 TO 18
  FOR R = 0 TO 24
    READ z
    PacMap(c, R) = z
    'PacMap(r, c) = Z
    IF z = 176 THEN
      LINE (R * 30, c * 30)-((R * 30) + 29, (c * 30) + 29), _RGB32(0, 0, 255), BF
    END IF
  NEXT R
NEXT c
RETURN

Placepac:
'extract whats at this row and column (should be 32)
z = PacMap(Pacrow, Paccol)
'add pacman symbol to it (32 +10 = 42)
z = z + Pacsym
'place in back inside map
PacMap(Pacrow, Paccol) = z
RETURN



'-------------------------- MAP --------------------------------------
DATA 176,176,176,176,176,176,176,176,176,176,176,176,32,176,176,176,176,176,176,176,176,176,176,176,176
DATA 176,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,176
DATA 176,32,176,176,176,176,176,176,176,176,176,32,176,32,176,176,176,176,176,176,176,176,176,32,176
DATA 176,32,176,32,32,32,32,32,32,32,32,32,176,32,176,32,32,32,32,32,32,32,176,32,176
DATA 176,32,176,32,176,176,176,176,32,176,176,32,176,32,176,32,176,176,176,176,176,32,176,32,176
DATA 176,32,176,32,176,32,32,32,32,32,176,32,176,32,176,32,32,32,32,32,32,32,176,32,176
DATA 176,32,176,32,176,32,176,176,32,176,176,32,176,32,176,32,176,32,176,32,176,32,32,32,176
DATA 176,32,32,32,176,32,32,32,32,32,32,32,32,32,32,32,176,32,176,32,176,32,176,32,176
DATA 176,32,176,32,176,32,176,176,176,32,176,176,32,176,176,32,32,32,176,32,32,32,176,32,176
DATA 32,32,176,32,32,32,32,32,32,32,176,32,32,32,176,32,176,176,176,176,176,32,176,32,32
DATA 176,32,176,32,176,32,176,176,176,32,176,176,176,176,176,32,32,32,176,32,32,32,176,32,176
DATA 176,32,32,32,176,32,32,32,32,32,32,32,32,32,32,32,176,32,176,32,176,32,176,32,176
DATA 176,32,176,32,176,32,176,176,32,176,176,32,176,32,176,32,176,32,176,32,176,32,32,32,176
DATA 176,32,176,32,176,32,32,32,32,32,176,32,176,32,176,32,32,32,32,32,32,32,176,32,176
DATA 176,32,176,32,176,176,176,176,32,176,176,32,176,32,176,32,176,176,176,176,176,32,176,32,176
DATA 176,32,176,32,32,32,32,32,32,32,32,32,176,32,176,32,32,32,32,32,32,32,176,32,176
DATA 176,32,176,176,176,176,176,176,176,176,176,32,176,32,176,176,176,176,176,176,176,176,176,32,176
DATA 176,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,176
DATA 176,176,176,176,176,176,176,176,176,176,176,176,32,176,176,176,176,176,176,176,176,176,176,176,176

Heres the updated GRAPHIC:http://dl.dropbox.com/u/10291175/GMPacMan1.rar


« Last Edit: September 17, 2011, 10:03:38 am by GarrisonRicketson » Report Spam   Logged

Pages: 1 2 [3] 4
  Print  
 
Jump to:  

Powered by EzPortal
Bookmark this site! | Upgrade This Forum
SMF For Free - Create your own Forum


Powered by SMF | SMF © 2016, Simple Machines
Privacy Policy