|
|
Post by bluatigro on Mar 4, 2021 10:16:46 GMT -5
this is stuf i made before but i want to inprove on it
error :
i got a white screen
it shoot show a red sphere
i think i made a typo somwere
the engine is not ready jet and so not used
dim vm(26,q(3,3)),sk(100,2)
global black:black=rgb(0,0,0)
global red:red=rgb(255,0,0)
global green:green=rgb(0,255,0)
global yellow:yellow=rgb(255,255,0)
global blue:blue=rgb(0,0,255)
global magenta:magenta=rgb(255,0,255)
global cyan:cyan=rgb(0,255,255)
global white:white=rgb(255,255,255)
global trans:trans=25
global rotx:rotx=24
global roty:roty=23
global rotz:rotz=22
global temp:temp=21
global temp2:temp2=26
call identity 0
global mtrxnu,height
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx,winy
winx=WindowWidth
winy=WindowHeight
open""for graphics as #m
#m "trapclose [quit]"
for height=0 to winy
call sphere 0,50,0,50,red
next height
wait
[quit]
close #m
end
sub sphere x,y,z,r,kl
if abs(height-z)<r then
d=sqr(r^2-(height-y)^2+.001)
kl1=mix(kl,.5-(height-y)/r/2,black)
#m "place ";winx/2+x;" ";winy*5/6-height-z/4
call setcolor kl1
#m "ellipsefilled ";d;" ";d/4
end if
if height=0 then
#m "place ";winx/2+x;" ";winy*5/6-z/4
call setcolor black
#m "ellipsefilled ";r;" ";r/4
end if
end sub
''3d math
function pend(fase,amp)
pend=sin(rad(fase))*amp
end function
sub skelet lim,x,y,z
if lim<0 or lim>100 then exit sub
sk(lim,0)=x
sk(lim,1)=y
sk(lim,2)=z
end sub
sub child no,x,y,z,lim,ax,p
call link no,x,y,z, _
sk(lim,1),sk(lim,0),sk(lim,2),ax,p
end sub
sub link no,x,y,z,xz,yz,xy,ax,p
if no<1 or no>20 then exit sub
if p<0 or p>20 then exit sub
if no=p then exit sub
call identity rotx
vm(rotx,q(1,1))=cos(rad(yz))
vm(rotx,q(1,2))=0-sin(rad(yz))
vm(rotx,q(2,1))=sin(rad(yz))
vm(rotx,q(2,2))=cos(rad(yz))
call identity roty
vm(roty,q(0,0))=cos(rad(xz))
vm(roty,q(0,2))=0-sin(rad(xz))
vm(roty,q(2,0))=sin(rad(xz))
vm(roty,q(2,2))=cos(rad(xz))
call identity rotz
vm(rotz,q(0,0))=cos(rad(yz))
vm(rotz,q(0,1))=0-sin(rad(yz))
vm(rotz,q(1,0))=sin(rad(yz))
vm(rotz,q(1,1))=cos(rad(yz))
call identity trans
vm(trans,12)=x
vm(trans,13)=y
vm(trans,14)=z
select case ax
case xyz
call mxmxm rotx,roty,rotz,p,no
case xzy
call mxmxm rotx,rotz,roty,p,no
case yxz
call mxmxm roty,rotx,rotz,p,no
case yzx
call mxmxm roty,rotz,rotx,p,no
case zxy
call mxmxm rotz,rotx,roty,p,no
case zyx
call mxmxm rotz,roty,rotx,p,no
case else
call mxmxm rotx,roty,rotz,p,no
end select
mtrxnu=no
end sub
function q(x,y)
q=x+y*4
end function
sub identity no
for i=0 to 3
for j=0 to 3
vm(no,i+j*4)=0
next j
vm(no,i*5)=1
next i
end sub
sub mxmxm a,b,c,p,uit
call mxm a,b,temp
call mxm temp,c,temp2
call mxm temp2,trans,temp
call mxm temp,p,uit
end sub
sub mxm a , b , uit
for i=0 to 3
for j=0 to 3
vm(uit,i+j*4)=0
for k=0 to 3
vm(uit,i+j*4)=vm(uit,i+j*4) _
+vm(a,i+k*4)*vm(b,k+j*4)
next k
next j
next i
end sub
''color math
function rgb(r,g,b)
r=int(r) and 255
g=int(g) and 255
b=int(b) and 255
rgb=r+g*256+b*256^2
end function
sub setcolor clr
r=int(clr)and 255
g=int(clr/256)and 255
b=int(clr/256^2)and 255
#m "color ";r;" ";g;" ";b
#m "backcolor ";r;" ";g;" ";b
end sub
function mix(clr1,f,clr2)
r1=int(clr1)and 255
g1=int(clr1/256)and 255
b1=int(clr1/256^2)and 255
r2=int(clr2)and 255
g2=int(clr2/256)and 255
b2=int(clr2/256^2)and 255
r=r1+f*(r2-r1)
g=g1+f*(g2-g1)
b=b1+f*(b2-b1)
mix=rgb(r,g,b)
end function
function rainbow(deg)
r=sin(rad(deg))*127+128
g=sin(rad(deg-120))*127+128
b=sin(rad(deg+120))*127+128
rainbow=rgb(r,g,b)
end function
function rad(deg)
rad=deg*pi/180
end function
|
|
|
|
Post by bluatigro on Mar 6, 2021 7:03:59 GMT -5
Rod : thanks i saw thed too update : bez and egg added a bez can jou use for a tail of a animal
dim vm(26,q(3,3)),sk(100,2)
global black:black=rgb(0,0,0)
global red:red=rgb(255,0,0)
global green:green=rgb(0,255,0)
global yellow:yellow=rgb(255,255,0)
global blue:blue=rgb(0,0,255)
global magenta:magenta=rgb(255,0,255)
global cyan:cyan=rgb(0,255,255)
global white:white=rgb(255,255,255)
global trans:trans=25
global rotx:rotx=24
global roty:roty=23
global rotz:rotz=22
global temp:temp=21
global temp2:temp2=26
global pi:pi=atn(1)*4
call identity 0
global mtrxnu,height
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx,winy
winx=WindowWidth
winy=WindowHeight
nomainwin
open""for graphics as #m
#m "trapclose [quit]"
for height=0 to winy
call sphere 0,50,0,50,red
call egg -200,200,0,70,200,200,0,70,10,green,0
call bez -200,400,0,1 _
,0,200,0,70 _
,200,600,0,20 _
,400,400,0,1,blue
next height
notice "ready"
wait
[quit]
close #m
end
sub sphere x,y,z,r,kl
if abs(height-y)<r then
d=sqr(r^2-(height-y)^2+.001)
kl1=mix(kl,.5-(height-y)/r/2,black)
#m "down"
#m "place ";winx/2+x;" ";winy*5/6-height-z/4
call setcolor kl1
#m "ellipsefilled ";d*2;" ";d/4
#m "up"
end if
if height=0 then
#m "down"
#m "place ";winx/2+x;" ";winy*5/6-z/4
call setcolor black
#m "ellipsefilled ";r*2;" ";r/4
#m "up"
end if
end sub
sub egg x1 , y1 , z1 , d1 , x2 , y2 , z2 , d2 , dm , kl , no
af = sqr( ( x1 - x2 ) ^ 2 _
+ ( y1 - y2 ) ^ 2 + ( z1 - z2 ) ^ 2 + 1 )
dx = ( x2 - x1 ) / af
dy = ( y2 - y1 ) / af
dz = ( z2 - z1 ) / af
dd = ( d2 - d1 ) / af
dh = ( d1 + d2 ) / 2
if no < 2 then no = af
if no > af then no = af
for i = 0 to af step af / no
call sphere x1 + dx * i _
, y1 + dy * i , z1 + dz * i _
, d1 + dd * i + sin( i * pi / af ) _
* ( dm - dh ) , kl
next i
end sub
sub bez x1,y1,z1,d1, x2,y2,z2,d2, x3,y3,z3,d3, x4,y4,z4,d4, kl
if ( abs( x1 - x2 ) <= 1 ) _
and ( abs( y1 - y2 ) <= 1 ) _
and ( abs( z1 - z2 ) <= 1 ) then
call sphere x1,y1,z1,d1,kl
else
ax = ( x1 + x2 ) / 2
ay = ( y1 + y2 ) / 2
az = ( z1 + z2 ) / 2
ad = ( d1 + d2 ) / 2
bx = ( x3 + x4 ) / 2
by = ( y3 + y4 ) / 2
bz = ( z3 + z4 ) / 2
bd = ( d3 + d4 ) / 2
cx = ( x3 + x2 ) / 2
cy = ( y3 + y2 ) / 2
cz = ( z3 + z2 ) / 2
cd = ( d3 + d2 ) / 2
a1x = ( ax + cx ) / 2
a1y = ( ay + cy ) / 2
a1z = ( az + cz ) / 2
a1d = ( ad + cd ) / 2
b1x = ( bx + cx ) / 2
b1y = ( by + cy ) / 2
b1z = ( bz + cz ) / 2
b1d = ( bd + cd ) / 2
c1x = ( a1x + b1x ) / 2
c1y = ( a1y + b1y ) / 2
c1z = ( a1z + b1z ) / 2
c1d = ( a1d + b1d ) / 2
call bez x1,y1,z1,d1 , ax,ay,az,ad , a1x,a1y,a1z,a1d , c1x,c1y,c1z,c1d , kl
call bez c1x,c1y,c1z,c1d , b1x,b1y,b1z,b1d , bx,by,bz,bd , x4,y4,z4,d4 , kl
end if
end sub
''3d math
function pend(fase,amp)
pend=sin(rad(fase))*amp
end function
sub skelet lim,x,y,z
if lim<0 or lim>100 then exit sub
sk(lim,0)=x
sk(lim,1)=y
sk(lim,2)=z
end sub
sub child no,x,y,z,lim,ax,p
call link no,x,y,z, _
sk(lim,1),sk(lim,0),sk(lim,2),ax,p
end sub
sub link no,x,y,z,xz,yz,xy,ax,p
if no<1 or no>20 then exit sub
if p<0 or p>20 then exit sub
if no=p then exit sub
call identity rotx
vm(rotx,q(1,1))=cos(rad(yz))
vm(rotx,q(1,2))=0-sin(rad(yz))
vm(rotx,q(2,1))=sin(rad(yz))
vm(rotx,q(2,2))=cos(rad(yz))
call identity roty
vm(roty,q(0,0))=cos(rad(xz))
vm(roty,q(0,2))=0-sin(rad(xz))
vm(roty,q(2,0))=sin(rad(xz))
vm(roty,q(2,2))=cos(rad(xz))
call identity rotz
vm(rotz,q(0,0))=cos(rad(yz))
vm(rotz,q(0,1))=0-sin(rad(yz))
vm(rotz,q(1,0))=sin(rad(yz))
vm(rotz,q(1,1))=cos(rad(yz))
call identity trans
vm(trans,12)=x
vm(trans,13)=y
vm(trans,14)=z
select case ax
case xyz
call mxmxm rotx,roty,rotz,p,no
case xzy
call mxmxm rotx,rotz,roty,p,no
case yxz
call mxmxm roty,rotx,rotz,p,no
case yzx
call mxmxm roty,rotz,rotx,p,no
case zxy
call mxmxm rotz,rotx,roty,p,no
case zyx
call mxmxm rotz,roty,rotx,p,no
case else
call mxmxm rotx,roty,rotz,p,no
end select
mtrxnu=no
end sub
function q(x,y)
q=x+y*4
end function
sub identity no
for i=0 to 3
for j=0 to 3
vm(no,i+j*4)=0
next j
vm(no,i*5)=1
next i
end sub
sub mxmxm a,b,c,p,uit
call mxm a,b,temp
call mxm temp,c,temp2
call mxm temp2,trans,temp
call mxm temp,p,uit
end sub
sub mxm a , b , uit
for i=0 to 3
for j=0 to 3
vm(uit,i+j*4)=0
for k=0 to 3
vm(uit,i+j*4)=vm(uit,i+j*4) _
+vm(a,i+k*4)*vm(b,k+j*4)
next k
next j
next i
end sub
''color math
function rgb(r,g,b)
r=int(r) and 255
g=int(g) and 255
b=int(b) and 255
rgb=r+g*256+b*256^2
end function
sub setcolor clr
r=int(clr)and 255
g=int(clr/256)and 255
b=int(clr/256^2)and 255
#m "color ";r;" ";g;" ";b
#m "backcolor ";r;" ";g;" ";b
end sub
function mix(clr1,f,clr2)
r1=int(clr1)and 255
g1=int(clr1/256)and 255
b1=int(clr1/256^2)and 255
r2=int(clr2)and 255
g2=int(clr2/256)and 255
b2=int(clr2/256^2)and 255
r=r1+f*(r2-r1)
g=g1+f*(g2-g1)
b=b1+f*(b2-b1)
mix=rgb(r,g,b)
end function
function rainbow(deg)
r=sin(rad(deg))*127+128
g=sin(rad(deg-120))*127+128
b=sin(rad(deg+120))*127+128
rainbow=rgb(r,g,b)
end function
function rad(deg)
rad=deg*pi/180
end function
|
|
|
|
Post by bluatigro on Mar 7, 2021 9:37:20 GMT -5
update :
example avatar
error :
sub hand does not work good
the feed are not viable
the pupils are not visable
WARNING :
drawing takes some minutes
dim vm(26,q(3,3)),sk(100,2)
global black:black=rgb(0,0,0)
global red:red=rgb(255,0,0)
global green:green=rgb(0,255,0)
global yellow:yellow=rgb(255,255,0)
global blue:blue=rgb(0,0,255)
global magenta:magenta=rgb(255,0,255)
global cyan:cyan=rgb(0,255,255)
global white:white=rgb(255,255,255)
global trans:trans=25
global rotx:rotx=24
global roty:roty=23
global rotz:rotz=22
global temp:temp=21
global temp2:temp2=26
global pi:pi=atn(1)*4
global links:links=0
global arm:arm=0
global elbow:elbow=1
global wrist:wrist=2
global leg:leg=3
global knee:knee=4
global enkle:enkle=5
global eye:eye=6
global neck:neck=7
global thumb:thumb=8
global index:index=11
global midle:midle=14
global ring:ring=17
global pinky:pinky=20
global tail:tail=23
global rechts:rechts=50
global lr:lr=50
global xyz:xyz=0
global xzy:xzy=1
global yxz:yxz=2
global yzx:yzx=3
global zxy:zxy=4
global zyx:zyx=5
call identity 0
global mtrxnu,height
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx,winy
winx=WindowWidth
winy=WindowHeight
nomainwin
open""for graphics as #m
#m "trapclose [quit]"
for height=0 to winy
call link 1,-200,110,0,0,0,0,xyz,0
call sqwirl green
call link 1,0,110,0,30,0,0,xyz,0
call sqwirl cyan
call link 1,200,110,0,90,0,0,xyz,0
call sqwirl magenta
next height
notice "ready"
wait
[quit]
close #m
end
sub sphere x,y,z,r,kl
call spot x,y,z
if abs(height-y)<r then
d=sqr(r^2-(height-y)^2+.001)
kl1=mix(kl,.5-(height-y)/r/2,black)
#m "down"
#m "place ";winx/2+x;" ";winy*5/6-height-z/4
call setcolor kl1
#m "ellipsefilled ";d*2;" ";d/4
#m "up"
end if
if height=0 then
#m "down"
#m "place ";winx/2+x;" ";winy*5/6-z/4
call setcolor black
#m "ellipsefilled ";r*2;" ";r/4
#m "up"
end if
end sub
sub egg x1 , y1 , z1 , d1 , x2 , y2 , z2 , d2 , dm , kl , no
af = sqr( ( x1 - x2 ) ^ 2 _
+ ( y1 - y2 ) ^ 2 + ( z1 - z2 ) ^ 2 + 1 )
dx = ( x2 - x1 ) / af
dy = ( y2 - y1 ) / af
dz = ( z2 - z1 ) / af
dd = ( d2 - d1 ) / af
dh = ( d1 + d2 ) / 2
if no < 2 then no = af
if no > af then no = af
for i = 0 to af step af / no
call sphere x1 + dx * i _
, y1 + dy * i , z1 + dz * i _
, d1 + dd * i + sin( i * pi / af ) _
* ( dm - dh ) , kl
next i
end sub
sub bez x1,y1,z1,d1, x2,y2,z2,d2, x3,y3,z3,d3, x4,y4,z4,d4, kl
if ( abs( x1 - x2 ) <= 1 ) _
and ( abs( y1 - y2 ) <= 1 ) _
and ( abs( z1 - z2 ) <= 1 ) then
call sphere x1,y1,z1,d1,kl
else
ax = ( x1 + x2 ) / 2
ay = ( y1 + y2 ) / 2
az = ( z1 + z2 ) / 2
ad = ( d1 + d2 ) / 2
bx = ( x3 + x4 ) / 2
by = ( y3 + y4 ) / 2
bz = ( z3 + z4 ) / 2
bd = ( d3 + d4 ) / 2
cx = ( x3 + x2 ) / 2
cy = ( y3 + y2 ) / 2
cz = ( z3 + z2 ) / 2
cd = ( d3 + d2 ) / 2
a1x = ( ax + cx ) / 2
a1y = ( ay + cy ) / 2
a1z = ( az + cz ) / 2
a1d = ( ad + cd ) / 2
b1x = ( bx + cx ) / 2
b1y = ( by + cy ) / 2
b1z = ( bz + cz ) / 2
b1d = ( bd + cd ) / 2
c1x = ( a1x + b1x ) / 2
c1y = ( a1y + b1y ) / 2
c1z = ( a1z + b1z ) / 2
c1d = ( a1d + b1d ) / 2
call bez x1,y1,z1,d1 , ax,ay,az,ad , a1x,a1y,a1z,a1d , c1x,c1y,c1z,c1d , kl
call bez c1x,c1y,c1z,c1d , b1x,b1y,b1z,b1d , bx,by,bz,bd , x4,y4,z4,d4 , kl
end if
end sub
sub hand i , kl
q = mtrxnu
call sphere 0,0,0,10 , kl
call egg 0,0,5,7 , 0,-20,10,7 , 7 , kl , 0
call egg 0,0,0,7 , 0,-25,0,7 , 7 , kl , 0
call egg 0,0,-5,7 , 0,-20,-10,7 , 7 , kl , 0
call child 6 , 0,-20,10 , ring + i , xyz , q
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 7 , 0,-10,0 , ring + i + 1 , xyz , 6
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 8 , 0,-10,0 , ring + i + 2 , xyz , 7
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 6 , 0,-25,0 , midle + i , xyz , q
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 7 , 0,-10,0 , midle + i + 1 , xyz , 6
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 8 , 0,-10,0 , midle + i + 2 , xyz , 7
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 6 , 0,-20,-10 , index + i , xyz , q
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 7 , 0,-10,0 , index + i + 1 , xyz , 6
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 8 , 0,-10,0 , index + i + 2 , xyz , 7
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 6 , 0,-10,-20 , thumb + i , xyz , q
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 7 , 0,-10,0 , thumb + i + 1 , xyz , 6
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
call child 8 , 0,-10,0 , thumb + i + 2 , xyz , 7
call egg 0,0,0,7 , 0,-10,0,7 , 7 , kl , 0
end sub
Sub kop qq , kl
call link 15, 0, 0, 0, 0, 0, 0,xyz, mtrxnu
call sphere 0, 0, 0, 30, kl
If qq = 1 Then
call sphere 25, 25, 0, 9, kl
call sphere -25, 25, 0, 9, kl
call sphere 0, 0, -40, 12, gray
Else
call sphere 30, 0, 0, 9, kl
call sphere -30, 0, 0, 9, kl
call sphere 0, 0, -40, 12, kl
End If
call child 16, 14, 14, -14, eye ,xyz, 15
call sphere 0, 0, 0, 13, white
call sphere 0, 0, -13, 7, black
call child 16, -14, 14, -14, eye + lr,xyz, 15
call sphere 0, 0, 0, 13, white
call sphere 0, 0, -13, 7, black
End Sub
sub sqwirl kl
call egg 0,0,0 , 30 , 0,40,0,10 , 25 , kl , 0
call egg -40,40,0 , 10 , 40,40,0 , 10 , 15 , kl , 0
call child 2 , 0,40,0 , neck , xyz , 1
call child 3 , 0,40,0 , neck+lr , zyx , 2''
call kop 1 , kl
call child 2 , 40,40,0 , arm , xzy , 1
call egg 0,0,0 , 10 , 0,-40,0 , 8 , 12 , kl , 0
call child 3 , 0,-40,0 , elbow , xyz , 2
call egg 0,0,0 , 8 , 0,-40,0 , 6 , 10 , kl , 0
call child 4 , 0,-40,0 , wrist , yxz , 3
call hand 0 , kl
call child 2 , 15,-15,0 , leg , yzx , 1
call egg 0,0,0 , 10 , 0,-40,0 , 8 , 12 , kl , 0
call child 3 , 0,-40,0 , knee , xyz , 2
call egg 0,0,0 , 8 , 0,-40,0 , 6 , 10 , kl , 0
call child 4 , 0 , -40,0 , enkle , xzy , 3
call egg 0,0,0 , 7 , 5,-3,-30 , 1 , 3 , kl , 0
call egg 0,0,0 , 7 , 0,-3,-30 , 1 , 3 , kl , 0
call egg 0,0,0 , 7 , -5,-3,-30 , 1 , 3 , kl , 0
call child 2 , -40,40,0 , arm+lr , xzy , 1
call egg 0,0,0 , 10 , 0,-40,0 , 8 , 12 , kl , 0
call child 3 , 0,-40,0 , elbow+lr , xyz , 2
call egg 0,0,0 , 8 , 0,-40,0 , 6 , 10 , kl , 0
call child 4 , 0,-40,0 , wrist+lr , yxz , 3
call hand lr , kl
call child 2 , -15,-15,0 , leg+lr , yzx , 1
call egg 0,0,0 , 10 , 0,-40,0 , 8 , 12 , kl , 0
call child 3 , 0,-40,0 , knee+lr , xyz , 2
call egg 0,0,0 , 8 , 0,-40,0 , 6 , 10 , kl , 0
call child 4 , 0 , -40,0 , enkle+lr , xzy , 3
call egg 0,0,0 , 7 , 5,-3,-30 , 1 , 3 , kl , 0
call egg 0,0,0 , 7 , 0,-3,-30 , 1 , 3 , kl , 0
call egg 0,0,0 , 7 , -5,-3,-30 , 1 , 3 , kl , 0
call child 2 , 0,0,20 , tail , xyz , 1
call bez 0,0,0 , 10 _
, 0,-15,20, 20 _
, 0,100,30 , 30 _
, 0,70,40, 1 , kl
end sub
''3d math
sub spot byref x,byref y,byref z
no=mtrxnu
hx=vm(no,0)*x+vm(no,1)*y+vm(no,2)*z+vm(no,3)
hy=vm(no,4)*x+vm(no,5)*y+vm(no,6)*z+vm(no,7)
hz=vm(no,8)*x+vm(no,9)*y+vm(no,10)*z+vm(no,11)
x=hx
y=hy
z=hz
end sub
function pend(fase,amp)
pend=sin(rad(fase))*amp
end function
sub skelet lim,x,y,z
if lim<0 or lim>100 then exit sub
sk(lim,0)=x
sk(lim,1)=y
sk(lim,2)=z
end sub
sub child no,x,y,z,lim,ax,p
call link no,x,y,z, _
sk(lim,1),sk(lim,0),sk(lim,2),ax,p
end sub
sub link no,x,y,z,xz,yz,xy,ax,p
if no<1 or no>20 then exit sub
if p<0 or p>20 then exit sub
if no=p then exit sub
call identity rotx
vm(rotx,q(1,1))=cos(rad(yz))
vm(rotx,q(1,2))=0-sin(rad(yz))
vm(rotx,q(2,1))=sin(rad(yz))
vm(rotx,q(2,2))=cos(rad(yz))
call identity roty
vm(roty,q(0,0))=cos(rad(xz))
vm(roty,q(0,2))=0-sin(rad(xz))
vm(roty,q(2,0))=sin(rad(xz))
vm(roty,q(2,2))=cos(rad(xz))
call identity rotz
vm(rotz,q(0,0))=cos(rad(yz))
vm(rotz,q(0,1))=0-sin(rad(yz))
vm(rotz,q(1,0))=sin(rad(yz))
vm(rotz,q(1,1))=cos(rad(yz))
call identity trans
vm(trans,3)=x
vm(trans,7)=y
vm(trans,11)=z
select case ax
case xyz
call mxmxm rotx,roty,rotz,p,no
case xzy
call mxmxm rotx,rotz,roty,p,no
case yxz
call mxmxm roty,rotx,rotz,p,no
case yzx
call mxmxm roty,rotz,rotx,p,no
case zxy
call mxmxm rotz,rotx,roty,p,no
case zyx
call mxmxm rotz,roty,rotx,p,no
case else
call mxmxm rotx,roty,rotz,p,no
end select
mtrxnu=no
end sub
function q(x,y)
q=x+y*4
end function
sub identity no
for i=0 to 3
for j=0 to 3
vm(no,i+j*4)=0
next j
vm(no,i*5)=1
next i
end sub
sub mxmxm a,b,c,p,uit
call mxm a,b,temp
call mxm temp,c,temp2
call mxm temp2,trans,temp
call mxm temp,p,uit
end sub
sub mxm a , b , uit
for i=0 to 3
for j=0 to 3
vm(uit,i+j*4)=0
for k=0 to 3
vm(uit,i+j*4)=vm(uit,i+j*4) _
+vm(a,i+k*4)*vm(b,k+j*4)
next k
next j
next i
end sub
''color math
function rgb(r,g,b)
r=int(r) and 255
g=int(g) and 255
b=int(b) and 255
rgb=r+g*256+b*256^2
end function
sub setcolor clr
r=int(clr)and 255
g=int(clr/256)and 255
b=int(clr/256^2)and 255
#m "color ";r;" ";g;" ";b
#m "backcolor ";r;" ";g;" ";b
end sub
function mix(clr1,f,clr2)
r1=int(clr1)and 255
g1=int(clr1/256)and 255
b1=int(clr1/256^2)and 255
r2=int(clr2)and 255
g2=int(clr2/256)and 255
b2=int(clr2/256^2)and 255
r=r1+f*(r2-r1)
g=g1+f*(g2-g1)
b=b1+f*(b2-b1)
mix=rgb(r,g,b)
end function
function rainbow(deg)
r=sin(rad(deg))*127+128
g=sin(rad(deg-120))*127+128
b=sin(rad(deg+120))*127+128
rainbow=rgb(r,g,b)
end function
function rad(deg)
rad=deg*pi/180
end function
|
|
