you need dbp with u58 for this funny source.
have fun ^^
rem best view with 1280x1024x32
rem fullscreen exlusive mode
rem set display mode 1280, 1024, 32
set display mode 1024, 768, 32
rem to reload all filedata from inet delete the 'testfile' in the
rem '...Dark Basic Software/Dark Basic Professional/TEMP' folder
InternetReadFiles("testfile")
sync rate 60 : sync on
for i = 1 to 6
load image str$(i) + ".jpg", i
next i
rem slow pc - make object sphere 1, 500, 15, 15
rem normal pc - make object sphere 1, 500, 25, 25
rem fast pc - make object sphere 1, 500, 30, 30
make object sphere 1, 500, 25, 25
make mesh from object 1, 1
set object wireframe 1, 1
set object cull 1, 0
ghost object on 1
set cube mapping on 1, 1, 2, 3, 4, 5, 6
limbs = MakeLimbObject(2, 1)
set object light 2, 0
set object cull 2, 0
set cube mapping on 2, 1, 2, 3, 4, 5, 6
cmap = MakeCubeMap(1, 2, 3, 4, 5, 6)
bass = PlayMod("ray.xm")
type tpoly
speed as float
x1 as float
y1 as float
z1 as float
state as float
x2 as float
y2 as float
z2 as float
endtype
dim poly(limbs) as tpoly
for i = 1 to limbs
poly(i).speed = 0.0005 + rnd(10) * 0.0001
poly(i).x1 = 0
poly(i).y1 = 0
poly(i).z1 = 0
poly(i).state = 0.0
poly(i).x2 = rnd(2048) - 1024
poly(i).y2 = 2048 + rnd(512)
poly(i).z2 = rnd(2048) - 1024
next i
repeat
fade object 1, 50 * sin(a#)
if GetPosMod(bass) > 3
for i= 1 to limbs
x# = CosInterpolation(poly(i).x1, poly(i).x2, poly(i).state)
y# = CosInterpolation(poly(i).y1, poly(i).y2, poly(i).state)
z# = CosInterpolation(poly(i).z1, poly(i).z2, poly(i).state)
offset limb 2, i, x#, y#, z#
rotate limb 2, i, x#, y#, z#
poly(i).state = poly(i).state + poly(i).speed
if poly(i).state > 1.0
poly(i).speed = 0.0010 + rnd(20) * 0.0001
poly(i).x1 = poly(i).x2
poly(i).y1 = poly(i).y2
poly(i).z1 = poly(i).z2
poly(i).state = 0.0
poly(i).x2 = rnd(2048) - 1024
poly(i).y2 = poly(i).y1 - rnd(512)
poly(i).z2 = rnd(2048) - 1024
endif
if poly(i).y2 < 0.1
poly(i).x2 = 0.0
poly(i).y2 = 0.0
poly(i).z2 = 0.0
endif
next i
endif
set cursor 0, 0
print screen fps()
set camera to follow 0, 0, 0, a#, 900 + sin(a# * 0.85) * 200, sin(a# * 0.40) * 200, 1, 0
point camera 0, 0, 0
position object cmap, camera position x(), camera position y(), camera position z()
a# = a# + 0.30
sync
until mouseclick()
StopMod(bass)
end
function MakeLimbObject(o, m)
make object triangle o, 0, 0, 0, 0, 0, 0, 0, 0, 0
mt = GetFreeMesh()
ot = GetFreeObject()
lock vertexdata for mesh m
c = get vertexdata vertex count() - 1
unlock vertexdata
for v = 0 to c step 3
lock vertexdata for mesh m
x1# = get vertexdata position x(v)
y1# = get vertexdata position y(v)
z1# = get vertexdata position z(v)
x2# = get vertexdata position x(v + 1)
y2# = get vertexdata position y(v + 1)
z2# = get vertexdata position z(v + 1)
x3# = get vertexdata position x(v + 2)
y3# = get vertexdata position y(v + 2)
z3# = get vertexdata position z(v + 2)
nx1# = get vertexdata normals x(v)
ny1# = get vertexdata normals y(v)
nz1# = get vertexdata normals z(v)
nx2# = get vertexdata normals x(v + 1)
ny2# = get vertexdata normals y(v + 1)
nz2# = get vertexdata normals z(v + 1)
nx3# = get vertexdata normals x(v + 2)
ny3# = get vertexdata normals y(v + 2)
nz3# = get vertexdata normals z(v + 2)
unlock vertexdata
make object triangle ot, x1#, y1#, z1#, x2#, y2#, z2#, x3#, y3#, z3#
make mesh from object mt, ot
inc l
add limb o, l, mt
delete mesh mt
delete object ot
lock vertexdata for limb o, l
set vertexdata normals 0, nx1#, ny1#, nz1#
set vertexdata normals 1, nx2#, ny2#, nz2#
set vertexdata normals 2, nx3#, ny3#, nz3#
unlock vertexdata
next v
delete mesh m
endfunction l
function InternetReadFiles(n$)
if file exist(n$) then exitfunction
load dll "wininet.dll", 1
call dll 1, "InternetAttemptConnect", 0
con = call dll(1, "InternetCheckConnectionA", "http://jukullmann.homepage.t-online.de/", 1)
if con = 0
print "Internet connection not found!"
print
print "Press a key ..."
delete dll 1
end
endif
make memblock 1, 200000
buffer = get memblock ptr(1)
size = make memory(4)
inet = call dll(1, "InternetOpenA", "media", 0, "", "", 0)
restore filedata
print "Loading Media from Internet ..."
print
repeat
read n$
print " - Loading " + n$;
url = call dll(1, "InternetOpenUrlA", inet, "http://jukullmann.homepage.t-online.de/" + n$, "", 0, 0, 0)
call dll 1, "InternetReadFile", url, buffer, 200000, size
call dll 1, "InternetCloseHandle", url
open to write 1, n$
s = *size
print " Size: ", s, " bytes";
for i = 0 to s - 1
write byte 1, memblock byte(1, i)
next i
print " >> OK <<"
close file 1
until n$ = "testfile"
call dll 1, "InternetCloseHandle", inet
delete memory size
delete memblock 1
delete dll 1
print
print "Press a key ..."
wait key
filedata:
data "1.jpg"
data "2.jpg"
data "3.jpg"
data "4.jpg"
data "5.jpg"
data "6.jpg"
data "ray.xm"
data "bassmod.dll"
data "testfile"
endfunction
function MakeCubeMap(i1, i2, i3 ,i4 ,i5 ,i6)
dim i(6)
i(1) = i1 : i(2) = i2 : i(3) = i3
i(4) = i4 : i(5) = i5 : i(6) = i6
o = GetFreeObject()
m = GetFreeMesh()
make object plain o, 3000, 3000
make mesh from object m, o
hide limb o, 0
restore cubedata
for l = 1 to 6
add limb o, l, m
read x, y, z
offset limb o, l, x, y, z
read x, y, z
rotate limb o, l, x, y, z
texture limb o, l, i(l)
next l
undim i(0)
delete mesh m
set object light o, 0
set object texture o, 2, 1
cubedata:
data -1500, 0, 0, 0, 90, 0
data 1500, 0, 0, 0, 270, 0
data 0, 1500, 0, 90, 180, 0
data 0, -1500, 0, 270, 180, 0
data 0, 0, 1500, 0, 180, 0
data 0, 0, -1500, 0, 0, 0
endfunction o
function PlayMod(n$)
m = GetFreeDLL()
load dll "bassmod.dll", m
call dll m, "BASSMOD_Init", -1, 44100, 0
call dll m, "BASSMOD_MusicLoad", 0, n$, 0, 0, 1030
call dll m, "BASSMOD_SetVolume", 100
call dll m, "BASSMOD_MusicPlay"
endfunction m
function GetPosMod(m)
r as word
r = call dll(m, "BASSMOD_MusicGetPosition")
endfunction r
function StopMod(m)
call dll m, "BASSMOD_Free"
delete dll m
endfunction
function CosInterpolation(a#, b#, c#)
f# = (1 - cos(c# * 180.0)) / 2
r# = a# * (1 - f#) + b# * f#
endfunction r#
function GetFreeObject()
repeat : inc o : until object exist(o) = 0
endfunction o
function GetFreeMesh()
repeat : inc m : until mesh exist(m) = 0
endfunction m
function GetFreeDLL()
repeat : inc l : until dll exist(l) = 0
endfunction l
