Simple goalless game with mario-like controls

DEFINT A-Z

TYPE actor
  alive   AS INTEGER
  oldx    AS INTEGER
  oldy    AS INTEGER
  oldface AS INTEGER
  x       AS SINGLE
  y       AS SINGLE
  xs      AS SINGLE
  ys      AS SINGLE
  face    AS INTEGER
  onfloor AS INTEGER
  jumping AS INTEGER
END TYPE

' Objects. 0 = player
DIM SHARED actors(0 TO 7) AS actor
' Playfield
DIM SHARED playfield(0 TO 39, 0 TO 24) AS INTEGER
' Graphics
DIM SHARED plrl(50), plrr(50), enml(50), enmr(50), tile(50)
' Keyboard
DIM SHARED keys(0 TO 127) AS INTEGER

' Initialize screen
InitializeGraphics

' Main loop
quit = 0
DO
  ' Process input
  xmove = 0
  jump  = 0
  DO
    a = INP(&H60) ' Read keyboard I/O port
    IF a < 128 THEN
      keys(a) = 1
    ELSEIF a < &HE0 THEN
      keys(a - 128) = 0
    END IF
  LOOP WHILE INKEY$ <> ""
  IF keys(1) THEN quit = 1      ' esc
  IF keys(&H48) THEN jump = 1   ' up
  IF keys(&H50) THEN REM        ' down
  IF keys(&H4B) THEN xmove = -1 ' left
  IF keys(&H4D) THEN xmove =  1 ' right

  ' Handle movement requests
  FOR n=0 TO 7
    IF xmove < 0 THEN actors(n).face = 1
    IF xmove > 0 THEN actors(n).face = 0
    IF xmove < 0 AND actors(n).xs > -2 THEN actors(n).xs = actors(n).xs - 0.25
    IF xmove > 0 AND actors(n).xs <  2 THEN actors(n).xs = actors(n).xs + 0.25
    IF xmove = 0 THEN actors(n).xs = actors(n).xs * 0.8: IF ABS(actors(n).xs) < 0.2 THEN actors(n).xs = 0
    IF jump <> 0 AND actors(n).jumping = 0 AND actors(n).onfloor <> 0 THEN
      actors(n).ys = -3
      actors(n).jumping = 1
    END IF
    IF jump = 0 THEN actors(n).jumping = 0
    IF jump = 0 AND actors(n).onfloor = 0 AND actors(n).ys < 0 THEN
      actors(n).ys = 0
    END IF
    actors(n).ys = actors(n).ys + 0.1 ' Apply gravity

    ' Very stupid enemy AI for actors 1-7
    xmove = INT(RND*3)-1
    jump  = INT(RND*2)
  NEXT

  ' Check collisions
  FOR n=0 TO 7
    IF actors(n).alive THEN
      xs = SGN(actors(n).xs)
      ys = SGN(actors(n).ys)
      x = actors(n).x + actors(n).xs
      y = actors(n).y + actors(n).ys
      IF playfield(INT((x+1)\8), INT(y\8)) <> 0 THEN actors(n).xs = actors(n).xs +0.3: IF xs < 0 THEN actors(n).xs = 0
      IF playfield(INT((x+7)\8), INT(y\8)) <> 0 THEN actors(n).xs = actors(n).xs -0.3: IF xs > 0 THEN actors(n).xs = 0
      IF ys < 0 AND playfield(INT((x+4)\8), INT((y+2)\8)) <> 0 THEN actors(n).ys = 0
      actors(n).onfloor = playfield(INT((x+4)\8), INT((y+6)\8)) <> 0
      IF ys > 0 AND actors(n).onfloor <> 0 THEN
        actors(n).y = INT(actors(n).y \ 8)*8+1 ' Normalize the Y position
        actors(n).ys = 0
      END IF
      actors(n).x = actors(n).x + actors(n).xs
      actors(n).y = actors(n).y + actors(n).ys
    END IF
  NEXT

  ' Wait for screen refresh to hide flickering
  WAIT &H3DA, &H8
  ' Wait for start of rendering
  WAIT &H3DA, &H8, &H8
  ' Render screen
  FOR n=0 TO 7
    x = actors(n).oldx: y = actors(n).oldy
    m = actors(n).oldface
    IF n=0 THEN
      IF x>0 THEN IF m=0 THEN PUT(x,y), plrr, XOR ELSE PUT(x,y),plrl, XOR
    ELSE
      IF x>0 THEN IF m=0 THEN PUT(x,y), enmr, XOR ELSE PUT(x,y),enml, XOR
    END IF

    x = actors(n).x: y = actors(n).y
    m = actors(n).face
    IF n=0 THEN
      IF x>0 THEN IF m=0 THEN PUT(x,y), plrr, XOR ELSE PUT(x,y),plrl, XOR
    ELSE
      IF x>0 THEN IF m=0 THEN PUT(x,y), enmr, XOR ELSE PUT(x,y),enml, XOR
    END IF

    actors(n).oldx = x: actors(n).oldy = y
    actors(n).oldface = m
  NEXT
LOOP WHILE quit = 0



SCREEN 0,1,0,0
WIDTH 80,25

' Define playing field
DATA XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
DATA X......................................X
DATA X......................................X
DATA X......................................X
DATA X...............XXXXXXXXXXXXXXX........X
DATA X......................................X
DATA X......................................X
DATA X.................................X....X
DATA X....XXXXXXXXXXXXX................XXXXXX
DATA X......................................X
DATA X......................................X
DATA X.......................X..............X
DATA X.......................X..............X
DATA X...............XXXXXXXXXXXXX..........X
DATA X.....XXXXXX...........................X
DATA X..........................XXXXXXX.....X
DATA X..XXXXX.......................X.......X
DATA X.................X............XXXX....X
DATA X.................X....................X
DATA X.....XXXXXXXXXXXXX..............XXXXXXX
DATA X......................................X
DATA X......................................X
DATA X......................................X
DATA X......................................X
DATA XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
DATA 1,10,170
DATA 1,40,20
DATA 1,100,20
DATA 1,140,20
DATA 1,220,20
DATA 1,40,100
DATA 1,100,100
DATA 1,140,120

SUB InitializeGraphics
  SCREEN 13
  LINE (0,0)-(15,15),0,BF:CIRCLE(4,4),3,70:PAINT(4,4),73,70:PSET(4,4),1:PSET(6,4),1
  GET (0,0)-(7,7), plrr
  LINE (0,0)-(15,15),0,BF:CIRCLE(4,4),3,70:PAINT(4,4),73,70:PSET(2,4),1:PSET(4,4),1
  GET (0,0)-(7,7), plrl

  LINE (0,0)-(15,15),0,BF:CIRCLE(4,4),3,&H27:PAINT(4,4),4,&H27:PSET(4,4),1:PSET(6,4),1
  GET (0,0)-(7,7), enmr
  LINE (0,0)-(15,15),0,BF:CIRCLE(4,4),3,&H27:PAINT(4,4),4,&H27:PSET(2,4),1:PSET(4,4),1
  GET (0,0)-(7,7), enml

  LINE(0,0)-(7,7),0,BF:LINE(0,3)-(7,3),4:LINE(0,0)-(7,0),12:LINE(0,1)-(7,2),6,BF
  LINE(0,4)-(7,4),12:LINE(0,5)-(7,6),6,BF:LINE(0,7)-(7,7),4:LINE(4,0)-(4,2),12:LINE(6,4)-(6,6),12:LINE(3,0)-(3,3),4:LINE(5,4)-(5,7),4
  GET(0,0)-(7,7),tile

  ' Clear screen
  LINE(0,0)-(319,199),0,BF

  FOR y=0 TO 24
    READ s$
    FOR x=0 TO 39
      playfield(x,y) = MID$(s$, x+1, 1) = "X"
      IF playfield(x,y) THEN
        PUT (x*8, y*8), tile, PSET
      END IF
    NEXT
  NEXT
  FOR n=0 TO 7
    READ actors(n).alive, actors(n).x, actors(n).y
    actors(n).onfloor = 1
    actors(n).xs = 0
    actors(n).ys = 0
    actors(n).oldx = -8
    actors(n).face = 0
  NEXT
END SUB