Algorithm partition for 3D Rendering

screenshot of my old version of 3D Rendering (ray tracing algorithm) developed with visualc++ 6.0 2003

PinBall with RFO BASIC! on smartphone!

REM Start of BASIC! Program

Wakelock 3

dim xc[10]
dim yc[10]
dim Rc[10],r[10],g[10],b[10],a[10]
dim xa[10],ya[10],xb[10],yb[10]

choc =1
dim s[3]
gravity =0.3

radius =50


GR.OPEN 255, 0, 0,0
GR.ORIENTATION 1
GR.SCREEN sx, sy

ARRAY.LOAD Pattern[],100,10

sensors.open 1

GR.BITMAP.LOAD ptr_ball, "billet.png"
gR.BITMAP.LOAD ptr_wood, "wood.jpg"
AUDIO.LOAD whee, "flip-on3.ogg.mp3"
AUDIO.LOAD boing, "boing.mp3"
AUDIO.LOAD wall0,"wall0.ogg.mp3"
AUDIO.LOAD goal,"goal.mp3"
AUDIO.LOAD music,"1.ogg.mp3"
dim ball[1],WOOD[1]


begin:

score = 0
alpha =255

x=rnd()*sx
y=450
vx=15
vy=20

KX=KY=0

k =1

dt=0
vmin =15
n=3
xc[1]=sx/2:yc[1]= 300:Rc[1]=60
r[1]=255:g[1]=0:b[1]=0:a[1]=255

xc[2]=sx/2-200:yc[2]= 600:Rc[2]=40
r[2]=0:g[2]=255:b[2]=0:a[2]=255

xc[3]=sx/2+200:yc[3]= 600:Rc[3]=40
r[3]=0:g[3]=0:b[3]=255:a[3]=255

xc[4]=sx/2:yc[4]= 900:Rc[4]=60
r[4]=255:g[4]=0:b[4]=255:a[4]=255

xb= sx/2:yb=sy-70
lx=100:ly=25

do

!start =time()


!sensors.read 1, s[1],s[2],s[3]
!gr.rotate.start s[1],sx/2,0

!gr.rotate.end


x+= vx
y+= vy

if x<radius then
AUDIO.STOP
AUDIO.PLAY wall0
vx=-k*vx
!if abs(vx)> vmin then vibrate Pattern[],-1
x=radius
endif
if x>sx-radius then
AUDIO.STOP
AUDIO.PLAY wall0
!if abs(vx)>vmin then vibrate Pattern[],-1
vx=-k*vx
x= sx-radius
endif

if y<radius then
AUDIO.STOP
AUDIO.PLAY wall0
!if abs(vy)>vmin then vibrate Pattern[],-1
vy=-k*vy
y=radius
endif
!if y>sy-radius then

!if abs(vy)>vmin then vibrate Pattern[],-1
!vy=-k*vy
!y= sy-radius
!endif


gr.touch touched, xt, yt
if touched & abs(xt-xb)<=lx & abs(yt-yb)<=ly+50 then
xb= xt:yb=yt
endif

gosub collision


!xb+=-8*s[1]

if xb+lx>sx then xb=sx-lx
if xb-lx<0 then xb=lx

if (x>=xb-lx-20) & (x<=xb+lx+20) & (abs(y+radius-yb+ly)<=40) & (vy>=0) then
vy=-vy+0.1*(yt-ytp)
vx+=0.1*(xt-xtp)
y= yb-ly-radius
!vibrate Pattern[],-1
endif

if y>=sy then
gr.cls
GR.TEXT.SIZE 100
GR.TEXT.DRAW nc,100,600,"YOU LOSE"
gr.render
AUDIO.STOP
AUDIO.PLAY goal
pause 2000

goto begin
endif


if touched=0 then
KX=KY=0
endif

xtp=xt:ytp=yt

!dt=(time()-start)/1000


xtp=xt:ytp=yt


gosub render
!gr.render

until 0

exit:
END


collision:
for i=1 to n
tx = x-xc[i]
ty = y-yc[i]
t = (tx*tx+ty*ty)^0.5
tx=tx/t
ty=ty/t
nx=-ty
ny=tx
vt = vx*tx+vy*ty
vn = vx*nx+vy*ny
if (t<=radius+Rc[i]) & (vt<0) & (a[i]>30) then

gr.color 255,255,255,255
gr.circle nc,xc[i],yc[i],Rc[i]

gr.render
AUDIO.STOP
AUDIO.PLAY whee
vx = 1.0*(-vt*tx+vn*nx)
vy= 1.0*(-vt*ty+vn*ny)
score+=10
if (a[i]>30) then a[i]=a[i]-20.
w =(a[1]<=30) & (a[2]<=30) & (a[3]<=30) & (a[4]<=30)
if w then
AUDIO.STOP
AUDIO.PLAY music
gr.cls
gr.color 255,255,255,255
GR.TEXT.SIZE 100
GR.TEXT.DRAW nc,100,600,"YOU WIN"
gr.render
pause 1000*60
goto begin
endif
!vibrate Pattern[],-1
endif
next i
return

render:
gr.color 255,0,0,0
gr.cls

gr.bitmap.draw WOOD[1],PTR_wood,0,0
gr.bitmap.draw ball[1],ptr_ball,x-radius,y-radius
gr.color 255,255,255,0,1
gr.rect nc, xb-lx, yb-ly, xb+lx, yb+ly

for i=1 to n
gr.color a[i],r[i],g[i],b[i]
gr.circle nc,xc[i],yc[i],Rc[i]
next i

gr.color 255,255,255,1
GR.TEXT.SIZE 50
GR.TEXT.DRAW nc,10,50,"SCORE="
GR.TEXT.DRAW nc,200,50,str$(score)
gr.render

return


line:
for k=1 to nl
tx = xa[k]-xb[k]
ty= ya[k]-yb[k]
t = sqrt(tx*tx+ty*ty)
tx=tx/t:ty=ty/t
nx = -ty: ny= tx
return

Mes salutations les plus profondes à ceux qui connaissent réellement la joie et la grande satisfaction qu'ils éprouvent devant la magnificence de l'art graphique engendrée par la beauté des mathématiques et qui se sont aventurés à travers les impulsions électroniques au sein du royaume des semi-conducteurs

the first release of the kaaba 3d VR screenshots rendered in real time and captured from galaxy note 2 ...

KIBLA 3D

 NEW KIBLA 3D DEVELOPMENT PROJECT ON MOBILE PHONE
- COMPASS indicating the directions North South East West
- GPS computes in real time  the position and direction of the qibla
- Modeling of the 3D HD kaaba
- NAVIGATION in VR mode (Virtual reality)...

Virtual Reality using smartphone's sensors like a camera3d in real world including 3d virtual graphics written in Mintoris Basic Pro language!

graphics on
WakeLock on
rounding on
orientation 2
sensors on

global hide
global x0, y0, z0, xorigin, yorigin
global a1, a2, a3, b1, b2, b3, c1, c2, c3, zoom, focal, rayon, distance
global hide
global azimuth,pitch,roll
dim o(3)
global alpha, theta, phi

xorigin = screenx()/2
yorigin = screeny()/2
theta = 0
phi = 0
distance = 5
x0 = 50
y0 = 0
z0 = 30
zoom = 3
focal = 150
rayon = 0
t = 0


do

o()= getorientation()
azimuth = -pi/180*o(0)
pitch= -pi/180*o(1)
roll= -pi/180*o(2)

color 0,0,0:CLS

teta = roll:phi =azimuth:alpha =-pitch

lookAt(teta, phi,alpha)

horizon(200):CUBE(30):axis(60)

touch x,y,1
loop while x=-1 and y=-1

END

sub delta(x, y, z)
return c1 * (x0 - x) + c2 * (y0 - y) + c3 * (z0 - z) + rayon + focal - distance
end sub

SUB CLIPPING(x1, y1, z1, x2, y2, z2)
test1 = delta(x1, y1, z1)
test2 = delta(x2, y2, z2)
hide = 0

IF test1 < 0 AND test2 < 0 THEN
hide = 1
GOTO fin
endif

IF test1 > 0 AND test2 > 0 THEN fin

IF test1 < 0 AND test2 > 0 THEN
xk = x1
yk = y1
zk = z1
landa = test2 / (c1 * (x2 - x1) + c2 * (y2 - y1) + c3 * (z2 - z1))
x1 = landa * (x2 - xk) + x2
y1 = landa * (y2 - yk) + y2
z1 = landa * (z2 - zk) + z2
GOTO fin
endif


IF test1 > 0 AND test2 < 0 THEN
xk = x2
yk = y2
zk = z2
landa = test1 / (c1 * (x2 - x1) + c2 * (y2 - y1) + c3 * (z2 - z1))
x2 = landa * (xk - x1) + x1
y2 = landa * (yk - y1) + y1
z2 = landa * (zk - z1) + z1
endif

fin:
END SUB


SUB CUBE(L)
color 100,100,100
line3d(-l, -l, -l, -l, -l, l)
line3d(-l, l, -l, -l, l, l)
line3d(l, l, -l, l, l, l)
line3d(l, -l, -l, l, -l, l)

line3d(-l, -l, l, -l, l, l)
line3d(-l, l, l, l, l, l)
line3d(l, l, l, l, -l, l)
line3d(l, -l, l, -l, -l, l)

line3d(-l, -l, -l, -l, l, -l)
line3d(-l, l, -l, l, l, -l)
line3d(l, l, -l, l, -l, -l)
line3d(l, -l, -l, -l, -l, -l)

'triangle3d(-l,-l,2*l,-l,l,2*l,l,l,2*l)
END SUB

SUB doprojection(x, y, z, xp, yp)
x=x-x0:y=y-y0:z=z-z0
Zdepth = -zoom*focal / (c1*x+ c2*y+c3*z - rayon - focal)
yp= Zdepth * (b1 * x + b2 * y +b3*z) +yorigin
xp= -Zdepth * (a1 * x + a2 * y + a3 * z ) +xorigin
END SUB

SUB horizon(p)
color 30,30,30
FOR k = -p TO p STEP 80
line3d(-p, k, 0, p, k, 0)
line3d(k, -p, 0, k, p, 0)
next k
END SUB

SUB line3d(x1, y1, z1, x2 , y2 , z2 )
CLIPPING(&x1, &y1, &z1, &x2, &y2, &z2)
IF hide = 0 THEN
doprojection(x1, y1, z1, &xp1, &yp1)
doprojection(x2, y2, z2, &xp2, &yp2)
LINE xp1, yp1,xp2, yp2
endif
END SUB


SUB triangle3d(x1, y1, z1, x2 , y2 , z2,x3,y3,z3 )
'CLIPPING(&x1, &y1, &z1, &x2, &y2, &z2)
'IF hide = 0 THEN
doprojection(x1, y1, z1, &xp1, &yp1)
doprojection(x2, y2, z2, &xp2, &yp2)
doprojection(x3, y3, z3, &xp3, &yp3)

triangle xp1, yp1,xp2, yp2,xp3,yp3,1
endif
END SUB

SUB lookAt(t, f,a)
teta = t
phi = f
alpha =a
ct = cos(teta)
st = sin(teta)
cf = cos(phi)
sf = sin(phi)
ca= cos(alpha)
sa= sin(alpha)

c1 = sf*st
c2 = -cf* st
c3 = ct
b1 = -cf*sa-sf*ct*ca
b2 = -sf*sa+cf*ct*ca
b3 = st*ca

a1 = cf*ca-sf*ct*sa
a2 = sf*ca+cf*ct*sa
a3 = st*sa
end sub

sub point3d(x, y, z)
test = delta(x, y, z)
IF test > 0 THEN
doprojection(x, y, z, &xp, &yp)
color 100,100,100
point xp, yp
endif
end sub


sub drawtext3d(t$,x, y, z)
test = delta(x, y, z)
IF test > 0 THEN
doprojection(x, y, z, &xp, &yp)
textsize 30
drawtext t$,xp,yp,90,0
endif
end sub


sub axi(L)
color 100,100,0
line3d(0,0,0,l,0,0)
textcolor 100,100,0
drawtext3d("X",l ,0,0)

color 100,0,0
line3d(0,0,0,0,l,0)
textcolor 100,0,0
drawtext3d("Y",0 ,l,0)

color 100,0,0
line3d(0,0,0,0,0,l)
textcolor 0,0,100
drawtext3d("Z",0 ,0,l)
end sub