When you run the program there will be a grid showing where a tile can go. You can use the mouse to add obstacle tiles by holding down the left button or remove tiles by holding down the right button.
When you tap the space bar gravity will be activated and the player (black rectangle) will descend until it hits an obstacle or the bottom of the screen.
The left and right arrow keys control direction along the x axis and the up arrow will cause the player to jump.
NOTE: The arrow keys only work when the player is sitting on an obstacle tile or bottom of screen.
While moving the player about you can use the mouse to continue to erase or add tiles.
Code: Select all
' hit1 o-------o hit2
' | |
' | |
' | |
' hit3 o o hit4
' | |
' | |
' | |
' hit5 o-------o hit6
const SCRW = 1280
const SCRH = 480
screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(200,200,255):cls
dim as integer mx,my,mb
dim shared as any ptr LAYER2
LAYER2 = imagecreate(SCRW,SCRH,rgb(255,0,255))
dim shared as integer hit1,hit2,hit3,hit4,hit5,hit6,hit
dim shared as integer hitTop,hitBot,hitLft,hitRht
type SPRITE
as integer x
as integer y
as integer w
as integer h
as integer xd
as integer yd
end type
dim shared as SPRITE s
s.x = 10
s.y = 10
s.w = 15
s.h = 25
sub update()
screenlock
cls
for j as integer = 0 to 23
for i as integer = 0 to 63
line (i*20,j*20)-step(20,20),rgb(127,127,127),b
next i
next j
put (0,0),LAYER2,trans
line (s.x,s.y)-step(s.w,s.h),rgb(0,0,0),bf
screenunlock
end sub
sub getHits()
hit1 = 0:hit2 = 0: hit3 = 0: hit4 = 0: hit5 = 0: hit6 = 0: hit = 0
if point(s.x,s.y,LAYER2)<>rgb(255,0,255) then 'top/left corner hit
hit1 = 1
end if
if point(s.x+s.w,s.y,LAYER2)<>rgb(255,0,255) then 'top/right corner hit
hit2 = 1
end if
if point(s.x,s.y+s.h\2,LAYER2)<>rgb(255,0,255) then 'middle/left side
hit3 = 1
end if
if point(s.x+s.w,s.y+s.h\2,LAYER2)<>rgb(255,0,255) then 'middle/right side
hit4 = 1
end if
if point(s.x,s.y+s.h,LAYER2)<>rgb(255,0,255) then 'bottom/left
hit5 = 1
end if
if point(s.x+s.w,s.y+s.h,LAYER2)<>rgb(255,0,255) then 'bottom/right
hit6 = 1
end if
hitTop = hit1 or hit2
hitBot = hit5 or hit6
hitLft = hit1 or hit3 or hit5
hitRht = hit2 or hit4 or hit6
if hitLft=1 and hitRht=1 then
hitLft=0
hitRht=0
end if
hit = hit1 or hit2 or hit3 or hit4 or hit5 or hit6
end sub
dim as string key
dim as integer go
dim as integer onGround
go = 0
s.yd = 0
do
key = inkey
if key = " " then
go = 1
s.yd = 4 'start gravity
end if
getmouse mx,my,,mb
if mb = 1 then
line LAYER2,(int(mx\20)*20,int(my\20)*20)-step(20,20),rgb(200,100,0),bf
end if
if mb = 2 then
line LAYER2,(int(mx\20)*20,int(my\20)*20)-step(20,20),rgb(255,0,255),bf
end if
onGround = 0
if point(s.x+s.w\2,s.y+s.h+1,LAYER2)<>rgb(255,0,255) then onGround = 1
if onGround = 1 then
s.xd = 0
if multikey(&H4D) then 'MOVE RIGHT
s.xd = 4
end if
if multikey(&H4B) then 'MOVE LEFT
s.xd = -4
end if
if multikey(&H48) then 'MOVE UP jump
s.yd = -15
end if
end if
if s.yd < 4 and go = 1 then s.yd = s.yd + 1
s.x = s.x + s.xd
s.y = s.y + s.yd
'test for out of bounds
if s.x < 0 then
s.x = 0
end if
if s.x > SCRW - s.w then
s.x = SCRW - s.w
end if
if s.y < 0 then
s.y = 0
end if
if s.y > SCRH - s.h then
s.y = SCRH - s.h
end if
'check for sprite/tile collision
getHits()
while hit = 1
if s.xd > 0 and hitRht = 1 then
s.x = s.x - 1
elseif s.xd < 0 and hitLft = 1 then
s.x = s.x + 1
elseif s.yd > 0 and hitBot = 1 then
s.y = s.y - 1
elseif s.yd < 0 and hitTop = 1 then
s.y = s.y + 1
end if
getHits()
wend
update()
sleep 2
loop until multikey(&H01)