'This is a small program using tile graphics. This source code is the property
'of James Tonn. You may modify this source code and use it in your own
'programs. You may use it in a written publication provided that it is not
'altered, and that you give credit to the author (James Tonn).
'I hope this code will help you in your programming.
'   -Jimmy Tonn 8/94
'   sltonn@phoenix.princeton.edu
'   sltonn@eden.rutgers.edu
'   jtonn@nerc1.nerc.com
'   75022.401@compuserve.com

DEFINT A-Z  'declare all variables starting with a through z as integers
SCREEN 13   'set screen mode 13, 320x200x256
CLS         'clear screen

RESTORE world   'restore data pointer so all data reading starts after label
                ' "world"

CONST ACROSS = 11 'this is the number of across tiles that will appear on
                  'the screen at a time, the total number of across tiles
                  'is stored in the variable tacross
CONST DOWN = 11   'number of down tiles on screen... total down tiles are
                  'stored in tdown

DIM blankimg(116) 'create an array for the blank tile
                  'this tile will be totally black, all zero's
DIM grassimg(116) 'create an array for the grass tile's image, 116 bytes
DIM treeimg(116)  'create an array for the tree tile's image, 116 bytes
DIM playerimg(116)'create as array for the player tile's image, 116 bytes

READ tacross, tdown  'get these values from the big data block "world"
                     'at the end of this program

TYPE tiletype          'create a type called tiletype
    x AS INTEGER       'the tile's x pixel coord
    y AS INTEGER       'the tile's y pixel coord
    style AS INTEGER   'the tile's style
END TYPE

DIM tile(tacross, tdown) AS tiletype 'declare array "tile" as tiletype

TYPE playertype  'create a type called playertype
    x AS INTEGER 'x tile where the player is
    y AS INTEGER 'y tile where the player is
    px AS INTEGER 'the players "permanant" x tile, the tile that he appears
                  'in out of the tiles on the screen
    py AS INTEGER 'the players "permanant" y tile
END TYPE

DIM player AS playertype 'declare the variable player as a playertype

READ player.x, player.y  'read player x and y coords from data block "world"
player.px = 6
player.py = 6

DEF FNSetlocs    'function to set pixel locs of tiles that appear on screen
   FOR a = 1 TO ACROSS
      FOR d = 1 TO DOWN
         tile(a, d).x = 15 * a  'set pixel x location of tile
         tile(a, d).y = 15 * d  'set pixel y location of tile
      NEXT d                    '(all tiles are 15x15 pixels)
   NEXT a
END DEF

DEF FNSetAtts   'function to read the styles of all tiles from data block
   FOR d = 1 TO tdown
      FOR a = 1 TO tacross
         READ tile(a, d).style 'read the tile's style
      NEXT a
   NEXT d
END DEF


'this next routine draws the tile on the screen
'the tx and ty variables are the tile numbers out of all the tiles
'the cx and cy variables are locations of the tile spaces where the tiles
'will be displayed on the screen
DEF FNDrawTile (tx, ty, cx, cy)
    SELECT CASE tile(tx, ty).style  'check the tile's style
          CASE 0  'if it's 0, draw an array of zero's (a black tile)
              PUT (tile(cx, cy).x, tile(cx, cy).y), blankimg, PSET
          CASE 1  'if it's 1, draw the grass tile
              PUT (tile(cx, cy).x, tile(cx, cy).y), grassimg, PSET
          CASE 2  'if it's 2, draw the tree tile
              PUT (tile(cx, cy).x, tile(cx, cy).y), treeimg, PSET
    END SELECT
END DEF

'this draws all the visible tiles on the screen
'it will draw from 5 tiles to the left of the player to 5 tiles to his right
'and from 5 tiles up to 5 tiles down
DEF FNDrawScreen
   FOR rela = -5 TO 5
      FOR reld = -5 TO 5
           dummy = FNDrawTile(player.x + rela, player.y + reld, player.px + rela, player.py + reld)
      NEXT reld
   NEXT rela
END DEF

'this function draws the player on the screen in his "permanant" location
DEF FNDrawPlayer
   PUT (tile(player.px, player.py).x, tile(player.px, player.py).y), playerimg, PSET
END DEF

DEF FNDisplayImg 'this function will read an images colors from a data block
                 'and display the image on the screen. Before calling this
                 'function, reset the data pointer to the beginning of the
                 'data block for the image.
   FOR dp = 1 TO 15
      FOR ap = 1 TO 15
         READ att                     'read the value at the point in the data block
         PSET (ap + 10, dp + 10), att 'put the pixel on the screen with the
                                      'color that was read from the data
                                      'block
      NEXT ap
   NEXT dp
END DEF

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' * * * * * * * * * * * * End of Function Defs* * * * * * * * * * * * * *

dummy = FNSetlocs   'set the locations for the on-screen tiles
dummy = FNSetAtts   'set the styles for all the tiles

GET (11, 11)-(25, 25), blankimg 'get an array that is all zero's, which will
                                'the black tile that we put around the edges
                                'of the map. No data reading is needed since
                                'the screen is already totally black. All
                                'we need to do is grab a block.

RESTORE grassdata   'restore the data pointer to the beginning of the data
                    'block that stores the grass tile's image. If you're
                    'reseting the data pointer to load the images, do it
                    'after calling FNSetLocs and FNSetAtts, because they
                    'need the data pointer in a certain place
dummy = FNDisplayImg  'call routine to read and display the image
GET (11, 11)-(25, 25), grassimg 'get the image into array "grassimg"
PUT (11, 11), grassimg, XOR     'put image over existing one to clear it

RESTORE treedata 'restore data pointer to beginning of the tree tile's image
dummy = FNDisplayImg 'read and display the image
GET (11, 11)-(25, 25), treeimg  'get the image into array "treeimg"
PUT (11, 11), treeimg, XOR  'put image on top of the old one to clear it

RESTORE playerdata 'restore pointer to beginning of player tile's image
dummy = FNDisplayImg 'read and display the image
GET (11, 11)-(25, 25), playerimg  'get the image into array "playerimg"
PUT (11, 11), playerimg, XOR  'put image on top of the old one to clear it

dummy = FNDrawScreen  'draw the screen once
dummy = FNDrawPlayer  'draw the player once


DO
  kbd$ = INKEY$            'get a "transparent" input
  IF kbd$ <> "" THEN       'if there actually was a user input, then...
    kbd$ = RIGHT$(kbd$, 1) 'get the first byte of the input (this is needed
                           'if you want to look for input from the cursor
                           'keys)
    SELECT CASE kbd$
          CASE CHR$(27)    'user pressed escape key
              END          'end the program
          CASE CHR$(72) 'user pressed up arrow
              IF tile(player.x, player.y - 1).style <> 2 THEN
              '^^^ check if the tile the player is about to move into is
              'already occupied by a tree.
              'if you check for a tree, you really don't need to check if
              'the player is going to go past the line of trees at the
              'edge with the other method, because if you check for a tree,
              'it will stop you before you go past the line anyway I just
              'added them both in case the reader wanted to use a certain
              'method for some reason.
               
                IF player.y - 1 > 5 THEN     'make sure he doesn't go past
                                             'the line of trees. You will
                                             'probably have to change this
                                             'number around if you change the
                                             'player's view screen size
                  player.y = player.y - 1    'decrease player y tile by one
                END IF
                dummy = FNDrawScreen       'draw the screen
                dummy = FNDrawPlayer       'put the player on the screen
              END IF
          CASE CHR$(80) 'user pressed down arrow
              IF tile(player.x, player.y + 1).style <> 2 THEN
              '^^^ check if the tile the player is about to move into is
              'already occupied by a tree.
                IF player.y + 1 < (tdown - 5) THEN 'keep player on screen
                  player.y = player.y + 1    'increase player y tile by one
                END IF
                dummy = FNDrawScreen       'draw the screen
                dummy = FNDrawPlayer       'put the player on the screen
              END IF
          CASE CHR$(75) 'user pressed left arrow
              IF tile(player.x - 1, player.y).style <> 2 THEN
              '^^^ check if the tile the player is about to move into is
              'already occupied by a tree.

                IF player.x - 1 > 5 THEN   'keep player on screen
                  player.x = player.x - 1    'decrease player x tile by one
                END IF
                dummy = FNDrawScreen       'draw the screen
                dummy = FNDrawPlayer       'put the player on the screen
              END IF
          CASE CHR$(77) 'user pressed right arrow
              IF tile(player.x + 1, player.y).style <> 2 THEN
              '^^^ check if the tile the player is about to move into is
              'already occupied by a tree.

                IF player.x < (tacross - 6) THEN  'keep player on screen
                  player.x = player.x + 1    'increase player x tile by one
                END IF
                dummy = FNDrawScreen       'draw the screen
                dummy = FNDrawPlayer       'put the player on the screen
              END IF
    END SELECT
  END IF
LOOP        'restart the main loop


world:

DATA 30,30
DATA 15,15
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,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,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,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,0,0,0,0,0,0
DATA 0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,2,1,1,1,1,1,2,1,1,1,1,1,2,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,1,1,1,1,1,2,1,1,1,1,1,1,2,1,1,1,1,2,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,2,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,2,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,2,1,1,1,1,1,1,1,1,2,1,1,2,1,1,1,2,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,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,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,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,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,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,0,0,0,0,0,0

grassdata:
DATA 0,0,0,0,2,0,0,0,148,0,0,2,0,0,0
DATA 0,2,0,0,0,0,0,0,0,0,0,0,0,0,141
DATA 0,0,0,0,142,0,0,2,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,2,0,0
DATA 0,2,0,2,0,145,0,0,0,142,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,2,0,0,0,0,0,2
DATA 0,0,0,142,0,0,0,0,0,0,0,2,0,0,0
DATA 0,2,0,0,0,142,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,2,0,0,147,0,0
DATA 0,142,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,2,0,0,142,0,0,2,0,0,0,2,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 2,0,0,0,0,145,0,2,0,0,0,0,2,0,0
DATA 0,0,0,2,0,0,0,0,0,0,0,0,0,0,142
DATA 145,0,0,0,147,0,0,0,2,0,0,2,0,0,0

treedata:
DATA 0,0,0,2,2,2,2,2,2,2,2,0,0,0,0
DATA 0,0,2,2,2,2,2,2,2,2,2,2,0,0,0
DATA 0,6,2,2,2,2,2,2,2,2,2,6,0,0,0
DATA 0,2,6,2,2,2,2,2,2,2,6,2,0,0,0
DATA 0,2,2,6,2,2,2,2,2,6,2,2,0,0,0
DATA 0,0,2,2,6,2,2,2,6,2,2,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,6,6,6,6,6,0,0,0,0,0,0
DATA 0,0,0,6,6,6,6,6,6,6,0,0,0,0,0

playerdata:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0
DATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0
DATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0
DATA 0,0,0,0,0,0,0,7,0,0,0,0,1,0,0
DATA 0,0,0,0,0,0,0,7,0,0,0,0,1,0,0
DATA 0,2,0,2,0,0,0,7,0,0,0,1,1,1,0
DATA 0,2,2,7,7,7,7,7,7,7,7,7,7,0,0
DATA 0,2,2,2,0,0,0,7,0,0,0,0,1,0,0
DATA 0,0,2,0,0,0,0,7,0,0,0,0,1,0,0
DATA 0,0,0,0,0,0,0,7,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,7,0,7,0,0,0,0,0,0
DATA 0,0,0,0,0,7,0,0,0,7,0,0,0,0,0
DATA 0,0,0,0,7,0,0,0,0,0,7,0,0,0,0
DATA 0,0,0,7,0,0,0,0,0,0,0,7,0,0,0

