Code: Select all
#include "crt/stdlib.bi"
#include "crt/string.bi"
#include "fbgfx.bi"
using FB
#define ScreenW 512
#define ScreenH 512
#define ScreenB ScreenH-1
#define ScreenM (ScreenW/2)
#define scan(x,n) for x as ulongint=0 to (n)
#define toIso(u,v,x,y) u=ScreenM+(x)-(y):v=ScreenB-(y)-(x)
#define mleft 1
#define mright -1
#define mtop 2
#define mbottom -2
#define mup 3
#define mdown -3
#define nSprites 16
type sprite
x as long
y as long
z as long
dx as long
dy as long
dz as long
movable as boolean
end type
dim shared as sprite mysprites(nSprites-1),copysprites(nSprites-1)
dim shared as sprite ptr draworder(nSprites-1)
dim shared as boolean spritedone(nSprites-1)
function cmpZ(u as sprite ptr ptr,v as sprite ptr ptr) as integer
var z1=(*u)->z
var z2=(*v)->z
if z1=z2 then return 0
return iif(z1<z2,1,-1)
end function
function cmpX(u as sprite ptr ptr,v as sprite ptr ptr) as integer
if (*v)->x>(*u)->x then return 1
return -1
end function
function cmpY(u as sprite ptr ptr,v as sprite ptr ptr) as integer
if (*v)->y>(*u)->y then return 1
return -1
end function
function intersect(sprite1 as ulong,sprite2 as ulong) as boolean
with copysprites(sprite1)
var x1=.x,dx1=.dx,y1=.y,dy1=.dy,z1=.z,dz1=.dz
with copysprites(sprite2)
var x2=.x,dx2=.dx,y2=.y,dy2=.dy,z2=.z,dz2=.dz
if x2+dx2<x1 then return false
if x2>x1+dx1 then return false
if y2+dy2<y1 then return false
if y2>y1+dy1 then return false
if z2+dz2<z1 then return false
if z2>z1+dz1 then return false
return true
end with
end with
end function
function moveit(sprite1 as ulong, direction as long) as boolean
with copysprites(sprite1)
if .movable=false then return false
select case direction
case mleft
.x-=1
case mright
.x+=1
case mtop
.y+=1
case mbottom
.y-=1
case mup
.z+=1
case mdown
if .z = 0 then return false
.z-=1
end select
end with
spritedone(sprite1)=true
scan(i,ubound(copysprites))
if not spritedone(i) then
if intersect(sprite1,i) then
if not moveit(i,direction) then
return false
end if
end if
end if
next
return true
end function
sub move(sprite1 as ulong,direction as long)
scan(i,ubound(spritedone)):spritedone(i)=false:next
memcpy(@copysprites(0),@mysprites(0),sizeof(sprite)*nSprites)
if moveit(sprite1,direction) then
memcpy(@mysprites(0),@copysprites(0),sizeof(sprite)*nSprites)
end if
end sub
''''''
screenres ScreenW,ScreenH,32
dim as long u1,v1,u2,v2
dim as any ptr isoTile
isoTile = imagecreate(31,46,0)
scan(i,15)
circle isoTile,(15,i+15),15,rgb(200,255,200),,,,F
next
circle isoTile,(15,15),15,rgb(0,0,0)
randomize()
scan(i,ubound(mysprites))
draworder(i)=@mysprites(i)
mysprites(i).x=i*18
mysprites(i).y=i*18
mysprites(i).dx=16
mysprites(i).dy=16
mysprites(i).dz=32
mysprites(i).movable=true
next
scan(i,ubound(mysprites))
swap mysprites(i).x,mysprites(int(ubound(mysprites)*rnd())).x
swap mysprites(i).y,mysprites(int(ubound(mysprites)*rnd())).y
mysprites(i).z=rnd()*50
next
Do
' Check arrow keys and update the (x, y) position accordingly
If MultiKey(SC_LEFT ) then move(0,mleft)
If MultiKey(SC_RIGHT) then move(0,mright)
If MultiKey(SC_UP ) then move(0,mtop)
If MultiKey(SC_DOWN ) then move(0,mbottom)
If MultiKey(SC_SPACE ) then move(0,mup):move(0,mup):move(0,mup):end if
scan(i,ubound(mysprites))
if mysprites(i).z>0 then move(i,mdown)
next
qsort(@draworder(0),ubound(draworder)+1,sizeof(sprite ptr),cptr(any ptr,@cmpZ))
qsort(@draworder(0),ubound(draworder)+1,sizeof(sprite ptr),cptr(any ptr,@cmpX))
qsort(@draworder(0),ubound(draworder)+1,sizeof(sprite ptr),cptr(any ptr,@cmpY))
ScreenLock
Cls
scan(i,16)
toIso(u1,v1,i*16,0)
toIso(u2,v2,i*16,256)
line (u1,v1)-(u2,v2)
next
scan(i,16)
toIso(u1,v1,0,i*16)
toIso(u2,v2,256,i*16)
line (u1,v1)-(u2,v2)
next
scan(i,ubound(draworder))
toIso(u1,v1,draworder(i)->x,draworder(i)->y)
put (u1,v1-draworder(i)->z),isoTile,Alpha
next
ScreenUnlock
sleep 15
Loop Until MultiKey(SC_ESCAPE)