Mapping

[DrChip]

REM bump mapping or something
'it's a bit slow and full of bugs

pi=3.1415
sw=screen_width()
sh=screen_height()
graphics
dim azb(1000,1000)
dim at(129,129,5),edge(4,1000,7)
dim ax(7),ay(7),az(7),asx(7),asy(7)
dim au(4),av(4),adx(31),ady(31),adz(31),abx(4),aby(4)
for y=0 to 127
for x=0 to 127
r=64-sqr((x-64)^2+(y-64)^2)
at(x,y,1)=40+rnd(10)
at(x,y,2)=40+rnd(10)
at(x,y,3)=40+rnd(10)
if r<0 or r>40 then goto n
r=r/64
r=1-cos(r*pi*3)
at(x,y,1)=(128+127*sin(x/40)*cos(y/40))*r
at(x,y,2)=(128+127*sin(x/12)*cos(y/30))*r
at(x,y,3)=(128+127*sin(x/50)*cos(y/12))*r

n:
'if x%10=0 or y%10=0 or x%10=1 or y%10=1 then
' at(x,y,1)=0
' at(x,y,2)=0
' at(x,y,3)=0
'end if
if x=2 or x=125 or y=2 or y=125 then
at(x,y,1)=1
at(x,y,2)=1
at(x,y,3)=1
end if
if x=1 or x=126 or y=1 or y=126 then
at(x,y,1)=1
at(x,y,2)=1
at(x,y,3)=1
end if

next x
next y

for y=0 to 127
for x=0 to 127
draw color at(x,y,1)/255,at(x,y,2)/255,at(x,y,3)/255
draw rect x,y to x,y+1
next x
next y


for i=0 to 8
read adx(i),ady(i),adz(i)
next i
ss=0
sn1=sin(.8)
cs1=cos(.8)

do
refresh off
for x=0 to 500
for y=0 to 500
azb(x,y)=10000
next y
next x

graphics clear 0,0,0
for i=0 to 7
dx=adx(i)*cs1+adz(i)*sn1
adz(i)=-adx(i)*sn1+adz(i)*cs1
adx(i)=dx

' adx=dx(i)*cs2+ady(i)*sn2
' ady(i)=-adx(i)*sn2+ady(i)*cs2
' adx(i)=dx

next i
sn1=sin(.1)
cs1=cos(.1)

for it=0 to 7
ax(0)=adx(it)
ay(0)=ady(it)+5
az(0)=adz(it)+400
itt=(it+1)%8
ax(1)=adx(itt)
ay(1)=ady(itt)+5
az(1)=adz(itt)+400
ax(2)=adx(8)
ay(2)=ady(8)+5
az(2)=adz(8)+400
half=it
gosub tri
next it
refresh on
until 1=0

data -100,100,0,0,100,0,100,100,0,100,0,0
data 100,-100,0,0,-100,0
data -100,-100,0,-100,0,0,0,0,0

tri:
if half=0 then
au(0)=0!av(0)=0
au(1)=64!av(1)=0
au(2)=64!av(2)=64
end if
if half=1 then
au(0)=64!av(0)=0
au(1)=127!av(1)=0
au(2)=64!av(2)=64
end if
if half=2 then
au(0)=127!av(0)=0
au(1)=127!av(1)=64
au(2)=64!av(2)=64
end if
if half=3 then
au(0)=127!av(0)=64
au(1)=127!av(1)=127
au(2)=64!av(2)=64
end if

if half=4 then
au(0)=127!av(0)=127
au(1)=64!av(1)=127
au(2)=64!av(2)=64
end if
if half=5 then
au(0)=64!av(0)=127
au(1)=0!av(1)=127
au(2)=64!av(2)=64
end if
if half=6 then
au(0)=0!av(0)=127
au(1)=0!av(1)=64
au(2)=64!av(2)=64
end if
if half=7 then
au(0)=0!av(0)=64
au(1)=0!av(1)=0
au(2)=64!av(2)=64
end if
vx1=ax(1)-ax(0)
vy1=ay(1)-ay(0)
vz1=az(1)-az(0)
vx2=ax(2)-ax(0)
vy2=ay(2)-ay(0)
vz2=az(2)-az(0)
vx=vy1*vz2-vz1*vy2+.1
vy=vz1*vx2-vx1*vz2
vz=vx1*vy2-vy1*vx2
vl=sqr(vx^2+vy^2+vz^2)
for i=0 to 2
ax(i+3)=ax(i)+vx/vl
ay(i+3)=ay(i)+vy/vl
az(i+3)=az(i)+vz/vl
next i
for i=0 to 5
d=sqr(ax(i)^2+ay(i)^2+az(i)^2)/sw
asx(i)=sw/2+ax(i)/d
asy(i)=sh/2-ay(i)/d
next i
for i=0 to 2
abx(i)=asx(i+3)-asx(i)
aby(i)=asy(i+3)-asy(i)
next i

p0=0
if asy(1)<asy(0) then p0=1
if asy(2)<asy(p0) then p0=2
p2=0
if asy(1)>asy(0) then p2=1
if asy(2)>asy(p2) then p2=2
p1=3-p0-p2
u0=au(p0)!u1=au(p1)!u2=au(p2)
v0=av(p0)!v1=av(p1)!v2=av(p2)
x0=asx(p0)!x1=asx(p1)!x2=asx(p2)
y0=asy(p0)!y1=asy(p1)!y2=asy(p2)
bx0=abx(p0)!bx1=abx(p1)!bx2=abx(p2)
by0=aby(p0)!by1=aby(p1)!by2=aby(p2)

xf=x0
dyf=y2-y0
dxf=(x2-x0)/dyf

uf=u0
duf=(u2-u0)/dyf

vf=v0
dvf=(v2-v0)/dyf

bxf=bx0
dbxf=(bx2-bx0)/dyf
byf=by0
dbyf=(by2-by0)/dyf


x=x0
u=u0
v=v0
dy=y1-y0+.1
dx=(x1-x0)/dy
du=(u1-u0)/dy
dv=(v1-v0)/dy
bx=bx0
by=by0
dbx=(bx1-bx0)/dy
dby=(by1-by0)/dy
a=2!b=1
if dxf<dx then
a=1
b=2
end if
for y=y0 to y1
edge(a,y,0)=xf
edge(a,y,1)=uf
edge(a,y,2)=vf
edge(a,y,3)=bxf
edge(a,y,4)=byf
edge(b,y,0)=x
edge(b,y,1)=u
edge(b,y,2)=v
edge(b,y,3)=bx
edge(b,y,4)=by
xf=xf+dxf
uf=uf+duf
vf=vf+dvf
bxf=bxf+dbxf
byf=byf+dbyf
x=x+dx
u=u+du
v=v+dv
bx=bx+dbx
by=by+dby
next y

x=x1
u=u1
v=v1
dy=y2-y1
dx=(x2-x1)/dy
du=(u2-u1)/dy
dv=(v2-v1)/dy
bx=bx1
by=by1
dbx=(bx2-bx1)/dy
dby=(by2-by1)/dy
for y=y1 to y2
edge(a,y,0)=xf
edge(a,y,1)=uf
edge(a,y,2)=vf
edge(a,y,3)=bxf
edge(a,y,4)=byf
edge(b,y,0)=x
edge(b,y,1)=u
edge(b,y,2)=v
edge(b,y,3)=bx
edge(b,y,4)=by
xf=xf+dxf
uf=uf+duf
vf=vf+dvf
bxf=bxf+dbxf
byf=byf+dbyf
x=x+dx
u=u+du
v=v+dv
bx=bx+dbx
by=by+dby
next y
zz=(az(0)+az(1)+az(2))*2
for y=y0 to y2 step .5
u=edge(1,y,1)
v=edge(1,y,2)
bx=edge(1,y,3)
by=edge(1,y,4)
dx=edge(2,y,0)-edge(1,y,0) +.1
du=(edge(2,y,1)-edge(1,y,1))/dx/2
dv=(edge(2,y,2)-edge(1,y,2))/dx/2
dbx=(edge(2,y,3)-edge(1,y,3))/dx/2
dby=(edge(2,y,4)-edge(1,y,4))/dx/2

x=edge(1,y,0)
while x<edge(2,y,0)
' for x=edge(1,y,0) to edge(2,y,0) step xres
'if at(u,v,1)=0 goto n1
bv=(at(u,v,1)+at(u,v,2)+at(u,v,3))/20
sx=x+(bx*bv)
sy=y+(by*bv)
zb=zz-bv*4
if zb>azb(sx,sy) then goto n1
azb(sx,sy)=zb

fill color at(u,v,1)/255,at(u,v,2)/255,at(u,v,3)/255
fill rect sx,sy to sx+2,sy+2
n1:
u=max(min(u+du,127),0)
v=max(min(v+dv,127),0)
bx=bx+dbx
by=by+dby
x=x+.5
end while
' next x
n2:
next y
return