Code:
rem ========================================================
rem Isometric test, from retrogamecoding.org.
rem
rem All the code presented here is the mix of a potential
rem library for isometric games.
rem
rem By Marcus.
rem ========================================================
import "Speed.lib"
import "Keycodes.lib"
import "Math.lib"
constant:
rem Reserved images.
ISO_TILES_IMAGE 325734
ISO_BLOCK_IMAGE_BASE 325735
ISO_MAX_SPRITES 100
ISO_BUCKET_SIZE 8
LEFT 12
RIGHT 0
DOWN 4
UP 8
visible:
iso_MapW
iso_MapH
iso_Floor[][]
iso_Blocks[][]
iso_Buckets[][][]
iso_SpriteCount
iso_Sprites?[ISO_MAX_SPRITES]
iso_TileW
iso_TileH
iso_BaseX
iso_BaseY
iso_BlockImages
iso_BlockHeights[]
iso_Factor#
iso_Steps[][]
markX
markY
hidden:
set window 32, 32, 320, 240, false, 2
set redraw off
if not ISO_LoadMap("Isometric_assets/map.txt") then end
load image 0, "Isometric_assets/marker.bmp"
set image colorkey 0, true
load image 1, "Isometric_assets/player.bmp"
set image colorkey 1, true
set image grid 1, 4, 4
player?
player.tx = 2
player.ty = 2
player.x# = float(player.tx) + 0.5
player.y# = float(player.ty) + 0.5
player.dir = LEFT
player.movep# = -1.0
proc ISO_SetSprite 0, 1, LEFT, player.x#, player.y#, 0, 5
steps = 0
step = 0
stepTimer = 0
movingByPath = false
path[16][2]
frame = 0
frameTimer = 0
do
if player.movep# < 0.0
if keydown(VK_LEFT)
if player.dir = LEFT and player.tx > 0 and iso_Blocks[player.tx - 1][player.ty] < 0
player.movep# = 0.0
else
player.dir = LEFT
endif
elseif keydown(VK_RIGHT)
if player.dir = RIGHT and player.tx < iso_MapW - 1 and iso_Blocks[player.tx + 1][player.ty] < 0
player.movep# = 0.0
else
player.dir = RIGHT
endif
elseif keydown(VK_UP)
if player.dir = UP and player.ty > 0 and iso_Blocks[player.tx][player.ty - 1] < 0
player.movep# = 0.0
else
player.dir = UP
endif
elseif keydown(VK_DOWN)
if player.dir = DOWN and player.ty < iso_MapH - 1 and iso_Blocks[player.tx][player.ty + 1] < 0
player.movep# = 0.0
else
player.dir = DOWN
endif
endif
else
player.movep# = min#(player.movep# + 0.05, 1.0)
dir = player.dir
if dir = LEFT
player.x# = float(player.tx) - player.movep# + 0.5
player.y# = float(player.ty) + 0.5
elseif dir = RIGHT
player.x# = float(player.tx) + player.movep# + 0.5
player.y# = float(player.ty) + 0.5
elseif dir = UP
player.x# = float(player.tx) + 0.5
player.y# = float(player.ty) - player.movep# + 0.5
else
player.x# = float(player.tx) + 0.5
player.y# = float(player.ty) + player.movep# + 0.5
endif
if player.movep# = 1.0
player.movep# = -1.0
if player.dir = LEFT
player.tx = player.tx - 1
elseif player.dir = RIGHT
player.tx = player.tx + 1
elseif player.dir = UP
player.ty = player.ty - 1
else
player.ty = player.ty + 1
endif
endif
endif
if player.movep# >= 0.0
proc ISO_SetSprite 0, 1, player.dir + frame, player.x#, player.y#, 0, 5
else
proc ISO_SetSprite 0, 1, player.dir, player.x#, player.y#, 0, 5
endif
set color 0, 0, 0
cls
set color 255, 255, 255
proc ISO_Render
frameTimer = (frameTimer + 1)%8
if frameTimer = 0 then frame = (frame + 1)%4
rem draw image 1, 32, 180, 4 + frame
set color 255, 255, 255
set caret width(primary)/2, height(primary) - 24
write "User arrow keys to walk."
redraw
wait 10
until keydown(27, true)
rem ========================================================
rem
rem ========================================================
procedure ISO_ClearSprites()
for i = 0 to ISO_MAX_SPRITES - 1
iso_Sprites[i].used = false
next
endproc
rem ========================================================
rem Load map
rem ========================================================
function ISO_LoadMap(filename$)
open file 0, filename$
if not file(0) then return false
rem Get path.
for i = len(filename) - 1 downto 0
if mid$(filename, i) = "/" then break
next
if i < 0
path$ = ""
else
path$ = left$(filename, i + 1)
endif
rem Read image filename.
imgFilename$ = path + read$(0)
rem Load image.
load image ISO_TILES_IMAGE, imgFilename
if not image(ISO_TILES_IMAGE)
free file 0
return false
endif
iso_TileW = read(0)
iso_TileH = iso_TileW/2
set image colorkey ISO_TILES_IMAGE, true
set image grid ISO_TILES_IMAGE, width(ISO_TILES_IMAGE)/iso_TileW, height(ISO_TILES_IMAGE)/iso_TileH
rem Load blocks.
iso_BlockImages = read(0)
iso_BlockHeights[iso_BlockImages]
for i = 0 to iso_BlockImages - 1
load image ISO_BLOCK_IMAGE_BASE + i, path + read$(0)
set image colorkey ISO_BLOCK_IMAGE_BASE + i, true
iso_BlockHeights[i] = read(0)
next
rem Init map with width and height from file.
iso_MapW = read(0)
iso_MapH = read(0)
iso_Floor[iso_MapW][iso_MapH]
iso_Blocks[iso_MapW][iso_MapH]
iso_Steps[iso_MapW][iso_MapH]
rem Load data.
for y = 0 to iso_MapH - 1
for x = 0 to iso_MapW - 1
iso_Floor[x][y] = read(0)
next
next
for y = 0 to iso_MapH - 1
for x = 0 to iso_MapW - 1
iso_Blocks[x][y] = read(0)
next
next
free file 0
rem Sprites.
proc ISO_ClearSprites
iso_Buckets[iso_MapW][iso_MapH][ISO_BUCKET_SIZE]
for y = 0 to iso_MapH - 1
for x = 0 to iso_MapW - 1
for i = 0 to ISO_BUCKET_SIZE - 1
iso_Buckets[x][y][i] = -1
next
next
next
rem Center.
iso_BaseX = (width(primary) - (iso_MapW*iso_TileW - iso_MapH*iso_TileW))/2
iso_BaseY = (height(primary) - iso_MapH*iso_TileH)/2
iso_Factor = 2.0/(sqr(2.0*float(iso_TileW*iso_TileW)))
return true
endfunc
rem ========================================================
rem Render.
rem ========================================================
procedure ISO_Render()
rem Du kan lägga alla koordinater i lookup, ev skapa en
rem bild för golvet.
halfW = iso_TileW/2
halfH = iso_TileH/2
bs = ISO_BUCKET_SIZE - 1
for y = 0 to iso_MapH - 1
for x = 0 to iso_MapW - 1
rem Coordinates.
drawX = iso_BaseX + x*halfW - y*halfW
drawY = iso_BaseY + y*halfH + x*halfH
rem Draw floor?
if iso_Floor[x][y] >= 0
draw image ISO_TILES_IMAGE, drawX, drawY, iso_Floor[x][y]
endif
next
next
for y = 0 to iso_MapH - 1
for x = 0 to iso_MapW - 1
rem Coordinates.
drawX = iso_BaseX + x*halfW - y*halfW
drawY = iso_BaseY + y*halfH + x*halfH
rem Draw block?
block = iso_Blocks[x][y]
if block >= 0
draw image ISO_BLOCK_IMAGE_BASE + block, drawX, drawY - iso_BlockHeights[block]
endif
rem Draw sprites.
for i = 0 to bs
sprite = iso_Buckets[x][y][i]
if sprite >= 0
img = iso_Sprites[sprite].img
drawX = iso_BaseX + int(iso_Sprites[sprite].x#*float(halfW) - iso_Sprites[sprite].y#*float(halfW)) + halfW - width(img)/2
drawY = iso_BaseY + int(iso_Sprites[sprite].y#*float(halfH) + iso_Sprites[sprite].x#*float(halfH)) - height(img) + iso_Sprites[sprite].by - iso_Sprites[sprite].z
draw image iso_Sprites[sprite].img, drawX, drawY, iso_Sprites[sprite].cel
endif
next
next
next
endproc
rem ========================================================
rem Conversion from screen to tile..
rem ========================================================
function ISO_ScreenToTileX(x, y)
v#[] = [float(x - iso_BaseX - iso_TileW/2)*iso_Factor, float(y - iso_BaseY)*2.0*iso_Factor]
proc V_Rotate v, -45.0
return int(v[0])
endfunc
rem ========================================================
rem Conversion from screen to tile..
rem ========================================================
function ISO_ScreenToTileY(x, y)
v#[] = [float(x - iso_BaseX - iso_TileW/2)*iso_Factor, float(y - iso_BaseY)*2.0*iso_Factor]
proc V_Rotate v, -45.0
return int(v[1])
endfunc
rem ========================================================
rem Conversion from tile to screen.
rem ========================================================
function ISO_TileToScreenX(x, y)
return iso_BaseX + x*iso_TileW/2 - y*iso_TileW/2
endfunc
rem ========================================================
rem Conversion from tile to screen.
rem ========================================================
function ISO_TileToScreenY(x, y)
return iso_BaseY + y*iso_TileH/2 + x*iso_TileH/2
endfunc
function ISO_TileHeight(x, y)
if x >= 0 and x < iso_MapW and y >= 0 and y < iso_MapH
block = iso_Blocks[x][y]
if block >= 0
return iso_BlockHeights[block]
endif
endif
return 0
endfunc
rem ========================================================
rem
rem ========================================================
procedure ISO_SetSprite(index, img, cel, x#, y#, z, baseY)
if iso_Sprites[index].used
iso_Sprites[index].img = img
iso_Sprites[index].cel = cel
iso_Sprites[index].x# = x
iso_Sprites[index].y# = y
iso_Sprites[index].z = z
iso_Sprites[index].by = baseY
tx = int(x)
ty = int(y)
if tx <> iso_Sprites[index].tx or ty <> iso_Sprites[index].ty
proc ISO_UnbucketSprite index
iso_Sprites[index].tx = tx
iso_Sprites[index].ty = ty
proc ISO_BucketSprite index
else
iso_Sprites[index].tx = tx
iso_Sprites[index].ty = ty
endif
else
iso_Sprites[index].used = true
iso_Sprites[index].img = img
iso_Sprites[index].cel = cel
iso_Sprites[index].x# = x
iso_Sprites[index].y# = y
iso_Sprites[index].z = z
iso_Sprites[index].by = baseY
iso_Sprites[index].tx = int(x)
iso_Sprites[index].ty = int(y)
proc ISO_BucketSprite index
endif
endproc
rem ========================================================
rem
rem ========================================================
procedure ISO_BucketSprite(index)
tx = iso_Sprites[index].tx
ty = iso_Sprites[index].ty
if tx >= 0 and tx < iso_MapW and ty >= 0 and ty < iso_MapH
for i = 0 to ISO_BUCKET_SIZE - 1
if iso_Buckets[tx][ty][i] < 0 then break
next
if i < ISO_BUCKET_SIZE
iso_Buckets[tx][ty][i] = index
endif
endif
endproc
rem ========================================================
rem
rem ========================================================
procedure ISO_UnbucketSprite(index)
tx = iso_Sprites[index].tx
ty = iso_Sprites[index].ty
if tx >= 0 and tx < iso_MapW and ty >= 0 and ty < iso_MapH
for i = 0 to ISO_BUCKET_SIZE - 1
if iso_Buckets[tx][ty][i] = i
iso_Buckets[tx][ty][i] = -1
break
endif
next
endif
endproc
rem ==================================================================
rem
rem ==================================================================
procedure ISO_ClearPathSteps()
for y = 0 to iso_MapH - 1
for x = 0 to iso_MapW - 1
iso_Steps[x][y] = 10000
next
next
endproc
rem ==================================================================
rem
rem ==================================================================
function ISO_GetPath(&path[][], fromX, fromY, toX, toY)
proc ISO_ClearPathSteps
return ISO_FindPath(path, fromX, fromY, toX, toY, 0)
endproc
rem ==================================================================
rem
rem ==================================================================
function ISO_FindPath(&path[][], x, y, toX, toY, step)
if step >= sizeof(path, 0) then return 0
if x < 0 or x >= iso_MapW or y < 0 or y >= iso_MapH then return 0
if step >= iso_Steps[x][y] then return 0
iso_Steps[x][y] = step
if iso_Floor[x][y] = -1 or iso_Blocks[x][y] >= 0 then return 0
step = step + 1
found = false
steps = 0
if x = toX and y = toY
steps = step
else
dx = toX - x
dy = toY - y
if dx > 0 and dy > 0
if iso_Floor[x][y + 1] >= 0 and iso_Floor[x + 1][y] >= 0 and iso_Blocks[x][y + 1] < 0 and iso_Blocks[x + 1][y] < 0
s = ISO_FindPath(path, x + 1, y + 1, toX, toY, step)
if s > 0 then steps = s
endif
elseif dx < 0 and dy < 0
if iso_Floor[x][y - 1] >= 0 and iso_Floor[x - 1][y] >= 0 and iso_Blocks[x][y - 1] < 0 and iso_Blocks[x - 1][y] < 0
s = ISO_FindPath(path, x - 1, y - 1, toX, toY, step)
if s > 0 then steps = s
endif
elseif dx < 0 and dy > 0
if iso_Floor[x][y + 1] >= 0 and iso_Floor[x - 1][y] >= 0 and iso_Blocks[x][y + 1] < 0 and iso_Blocks[x - 1][y] < 0
s = ISO_FindPath(path, x - 1, y + 1, toX, toY, step)
if s > 0 then steps = s
endif
elseif dx > 0 and dy < 0
if iso_Floor[x][y - 1] >= 0 and iso_Floor[x + 1][y] >= 0 and iso_Blocks[x][y - 1] < 0 and iso_Blocks[x + 1][y] < 0
s = ISO_FindPath(path, x + 1, y - 1, toX, toY, step)
if s > 0 then steps = s
endif
endif
if abs(toX - x) > abs(toY - y)
if toX > x
s = ISO_FindPath(path, x + 1, y, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x - 1, y, toX, toY, step)
if s > 0 then steps = s
else
s = ISO_FindPath(path, x - 1, y, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x + 1, y, toX, toY, step)
if s > 0 then steps = s
endif
if toY > y
s = ISO_FindPath(path, x, y + 1, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x, y - 1, toX, toY, step)
if s > 0 then steps = s
else
s = ISO_FindPath(path, x, y - 1, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x, y + 1, toX, toY, step)
if s > 0 then steps = s
endif
else
if toY > y
s = ISO_FindPath(path, x, y + 1, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x, y - 1, toX, toY, step)
if s > 0 then steps = s
else
s = ISO_FindPath(path, x, y - 1, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x, y + 1, toX, toY, step)
if s > 0 then steps = s
endif
if toX > x
s = ISO_FindPath(path, x + 1, y, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x - 1, y, toX, toY, step)
if s > 0 then steps = s
else
s = ISO_FindPath(path, x - 1, y, toX, toY, step)
if s > 0 then steps = s
s = ISO_FindPath(path, x + 1, y, toX, toY, step)
if s > 0 then steps = s
endif
endif
endif
if steps
path[step - 1][0] = x
path[step - 1][1] = y
endif
return steps
endfunc
