hi,
Still after all these years, there's nought like DPB.
Here's a 3d tetris I'm working on.
and a link
http://www.madglue.com/3dt/3dt.exe
and the code
global speed#
global xspeed#
load sound "l3.wav",1
load sound "s1.wav",2
load sound "s2.wav",3
load sound "c2.wav",4
load sound "r1.wav",5
load sound "q1.wav",6
load sound "b1.wav",7
loop sound 7
gosub set_screen
graphics()
make_house_and_track()
make_shapes()
replay:
linex=0:linex1=0
linez=0:linez1=0
w=0:walls=0
icount=0
position object 1001,5,28.5,5
position object 1002,5,3.1,5
gosub make_floor_points
gosub make_first_clone
`
position camera 5,40.5,5:xrotate camera 90
`
a#=timer()
do
if screen fps()>32 then speed#= (3.0 /screen fps()) + xspeed#
`
set sound volume 1,0
gosub time
gosub down
on=shift(i,on)
on=rotate(i,on)
on=speed(i,on)
on=spin(i,on)
gosub move_house
on=pause(on)
restart()
gosub onscreen_text
text 10,100,str$(screen fps())
`
sync
loop
``````````````````````````````````````
set_screen:
dw=get display width() : dh=get display height() : dd=get display depth()
set display mode dw,dh,dd
maximize window
sync on : randomize timer()
return
`````````````````````````````````````````
make_floor_points:
undim lpx(0) : undim lpy(0) : undim lpz(0)
dim lpx(4) : dim lpy(4) : dim lpz(4)
py=2
undim points(0)
dim points(11,31,11)
for px = 0 to 11
for pz = 0 to 11
points(px,py,pz)=1
next pz
next px
return
`````````````````````````````````````
make_first_clone:
i=5
for t = i to 400
if object exist(t)=1then delete object t
next t
clone object i,1+rnd(3):position object i,rnd(9)+0.5,30,rnd(9)+0.5
play sound 1
return
```````````````````````````````````
time:
b#=(timer()-a#)/1000
mins#=b#/60
secs#=b#-(int(mins#)*60)
return
down:
move camera speed#
gosub position_track
`
godownbut=0
for t = 0 to 3
lpx(t)=limb position x(i,t):lpy(t)=limb position y(i,t)-1:lpz(t)=limb position z(i,t)
if points(lpx(t),lpy(t),lpz(t))=1 then godown=1
if points(lpx(t),lpy(t),lpz(t))=0 then godownbut=1
next t
`
if godown=0
move object down i,speed#
else stop=1
endif
`
if stop=1
for s = 0 to 3
points(lpx(s),lpy(s)+1,lpz(s))=1
next s
gosub check_lines
if sound playing(1) =1 then stop sound 1
if godownbut=0 then play sound 4 else play sound 6
`
fade object i,25
inc i
inc icount
clone object i,1+rnd(3):position object i,rnd(9)+0.5,25+w,rnd(9)+0.5
if sound playing(1) =0 then play sound 1
`
position camera 5,40+w,5:xrotate camera 90
stop=0
godown=0
godownbut=0
`
endif
`
return
``````````````````````````````````
move_house:
if on=0
if inkey$()="w" or icount=24
move object up 1001,1
move object up 1002,1
inc w
for px = 0 to 11
for pz = 0 to 11
points(px,w+2,pz)=1
next pz
next px
inc linex1,linex:linex=0
inc linez1,linez:linez=0
if inkey$()="w" then inc walls
on=1
inc speed#,(speed#/5)
icount=0
endif
endif
return
`````````````````````````````````````````
position_track:
position object 1003,object position x(i),0,object position z(i)
scale object 1003,5,100 + (object position y(i)*200) ,5
return
``````````````````````````````````````
check_lines:
linex=0
linez=0
checkx=0
checkz=0
for y = 3+w to 30
for z = 0 to 10
checkx=0
checkz=0
for x = 0 to 10
if points(x,y,z)=1 then inc checkx
if checkx =10 then inc linex : checkx=0
if points(z,y,x)=1 then inc checkz
if checkz =10 then inc linez : checkz=0
next x
next z
next y
return
````````````````````````````````````````````
onscreen_text:
center text dw/2,dh-40,"Left, Right, Up and Down keys. Q for quicker. S for slower. W for new wall. Spacekey to rotate. B to flip. R to restart."
center text dw/2,10,"SPEED " + str$(int((speed#+xspeed#)*200)) + " LINEX " + str$(linex+linex1) + " LINEZ " + str$(linez+linez1) + " WALLS " + str$(walls) + " TIME " + str$(int(mins#))+":"+str$(int(secs#))
return
```````````````````````````````````````````````````
function graphics()
while c<4
inc c
cls rgb(rnd(255),rnd(255),rnd(255))
a=6 : b=14
for t = 1 to 4
ink rgb(188,rnd(188),rnd(188)),0
line a-t,a-t,b+t,a-t
line a-t,b+t,b+t,b+t
line a-t,a-t,a-t,b+t
line b+t,a-t,b+t,b+t
next t
get image c,0,0,20,20,1
endwhile
`
cls rgb(100+rnd(155),100+rnd(155),100+rnd(155))
`
for t = 0 to 100 step 10
ink rgb(rnd(88),rnd(88),rnd(88)),0
line 0,t,100,t
ink rgb(rnd(88),rnd(88),rnd(88)),0
line t,0,t,100
next t
get image 1001,0,0,100,100,1
`
set text font "arial" : set text size 22 : ink rgb(155,0,0),0
endfunction
```````````````````````````````````````````````
function make_house_and_track()
make object box 1001,10,50,10:position object 1001,5,28.5,5:texture object 1001,1001:set object 1001,1,0,0:scale object texture 1001,1,4
make object box 1002,10,1,10:position object 1002,5,3.1,5:texture object 1002,1001:`scale object texture 1002,1,0.1
make light 1:position light 1,32,25,32:color light 1,rgb(55,155,55)
make object cube 1003,1 : position object 1003,5,-1,5 : color object 1003,0
endfunction
```````````````````````````````````````
function make_shapes()
make object cube 1,1:position object 1,1000,0,0 : texture object 1,1:
make mesh from object 1,1
add limb 1,1,1 : offset limb 1,1,0,0,-1 : texture limb 1,1,1
add limb 1,2,1 : offset limb 1,2,-1,0,-1 : texture limb 1,2,1
add limb 1,3,1 : offset limb 1,3,-1,0,0 : texture limb 1,3,1
`
make object cube 2,1:position object 2,2000,0,0 : texture object 2,2:
make mesh from object 2,2
add limb 2,1,2 : offset limb 2,1,-1,0,0 : texture limb 2,1,2
add limb 2,2,2 : offset limb 2,2,1,0,0 : texture limb 2,2,2
add limb 2,3,2 : offset limb 2,3,1,0,-1 : texture limb 2,3,2
`
make object cube 3,1:position object 3,3000,0,0 : texture object 3,3:
make mesh from object 3,3
add limb 3,1,3 : offset limb 3,1,-1,0,0 : texture limb 3,1,3
add limb 3,2,3 : offset limb 3,2,0,0,-1 : texture limb 3,2,3
add limb 3,3,3 : offset limb 3,3,1,0,-1 : texture limb 3,3,3
`
make object cube 4,1:position object 4,4000,0,0 : texture object 4,4:
make mesh from object 4,4
add limb 4,1,4 : offset limb 4,1,-1,0,0 : texture limb 4,1,4
add limb 4,2,4 : offset limb 4,2,1,0,0 : texture limb 4,2,4
add limb 4,3,4 : offset limb 4,3,0,0,-1 : texture limb 4,3,4
`
endfunction
```````````````````````````````````````
function shift(i,on)
`
if on=0
if leftkey()=1 then move object left i,1 : play sound 2 : on=1
if rightkey()=1 then move object right i,1 : play sound 3 : on=1
if upkey()=1 then move object i,1 : play sound 2 : on=1
if downkey()=1 then move object i,-1 : play sound 3 : on=1
endif
`
for a = 0 to 3
if limb position x(i,a)>10 then move object left i,1
if limb position x(i,a)<0 then move object right i,1
if limb position z(i,a)>10 then move object i,-1
if limb position z(i,a)<0 then move object i,1
next t
`
endfunction on
```````````````````````````````````
function rotate(i,on)
if on=0
if spacekey()=1 then yrotate object i,object angle y(i)+90 : fix object pivot i : play sound 5 : on=1
endif
endfunction on
```````````````````````````````````
function spin(i,on)
if on=0
if inkey$()="b" then zrotate object i,object angle z(i)+180 : fix object pivot i : on=1
endif
endfunction on
````````````````````````````````
function speed(i,on)
if on=0
if inkey$()="q" then inc xspeed#,speed#/5.0: on=1
if inkey$()="s" then dec xspeed#,speed#/5.0: on=1
endif
if speed#<0.0005 then speed#=0
endfunction on
````````````````````````````````
function pause(on)
if on=0
if inkey$()="p" then inc p: on=1
if p>1 then p=0
if p=1 then : pause sound 1 : stop sound 7 : wait key
if sound playing(1)=0 then resume sound 1
if sound playing(7)=0 then loop sound 7
endif
on=scancode()
endfunction on
``````````````````````````````````
function restart()
if inkey$()="r"
sync
goto replay
endif
endfunction
It needs the enhancements dll...(everyone's got that.)
Here's the sounds, if anyone's interested.
The graphics are all coded.
There's no collision involved.
All placements are array based.
grateful for any comments.
cheers,
miki...
in the end