REM 3d Manimotion Demo v3
REM A 3D demo with a twist!
REM iPhone 6 Plus / 8.2 b4
REM very buggy. I'm still working on it.
REM v2 - fixed bugs, floor and lighting.
REM v3 - sound added, background color
REM fixed scroller.
REM enjoy...
def reload
notes load "/Examples/10. Music & Sound/files/test7.mid"
notes play
enddef
reload
graphics
'SET UP ALL VARIABLES
GOSUB setup
rr=rnd(1)
gg=rnd(1)
bb=rnd(1)
cr=1
cb=1
cg=1
'Start Loop
loop:
cr=cr+rr
cg=cg+gg
cb=cb+bb
if cr>255 or cr <1 then rr = -rr
if cg>255 or cg <1 then gg = -gg
if cb>255 or cb <1 then bb = -bb
refresh off
'graphics clear 0,0,0
fd=fad/10
fill COLOR cr/255,cg/255,cb/255
'top back
'triangle 0,0 to sw,sh to 0,sh
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh-90
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle 0,0 to sw,sh-40 to sw,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh-90
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
fill COLOR 170/255,170/255,210/255
'bottom back
'triangle 0,sh-40 to sw,sh to sw,sh-40
trix(0)=0
triy(0)=sh-90
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=sh-90
fill poly trix,triy count 3
'triangle 0,sh-40 to sw,sh to 0,sh
trix(0)=0
triy(0)=sh-90
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
GOSUB rotate 'ROTATE OBJECT
GOSUB construct 'DRAW OBJECT
mh=mh+1
IF mh>25 THEN
GOSUB morph
END IF
IF mh>50 THEN
mt=mt+1
IF mt>mxo THEN
mt=1
END IF
mh=0
END IF
fill COLOR 170/255,170/255,210/255
fill RECT 0,0 to sw,40
draw COLOR 0,0,0
DRAW TEXT "Manimotion Demo" at sw/4,10
draw COLOR 1,1,1
DRAW TEXT "Manimotion Demo" at sw/4,12
draw COLOR 1,1,1
DRAW TEXT MID$(s$,p,67) at scx,38
draw COLOR 0,0,0
DRAW TEXT MID$(s$,p,67) at scx+2,40
scx=scx-5 'scroll speed 1 slowest 10 fastest
IF scx<-10 THEN
scx=scx+10
p=p+1
IF p>LEN(s$)-1 THEN
p=0
END IF
END IF
refresh on
GOTO loop 'End Loop
RETURN
morph:
FOR a=1 TO points
IF x(a)<mx(a,mt) THEN
x(a)=x(a)+.05
END IF
IF x(a)>mx(a,mt) THEN
x(a)=x(a)-.05
END IF
IF y(a)<my(a,mt) THEN
y(a)=y(a)+.05
END IF
IF y(a)>my(a,mt) THEN
y(a)=y(a)-.05
END IF
IF z(a)<mz(a,mt) THEN
z(a)=z(a)+.05
END IF
IF z(a)>mz(a,mt) THEN
z(a)=z(a)-.05
END IF
NEXT a
RETURN
'Control sub to Draw The Object
construct:
FOR a=1 TO faces
'DO EACH FACE IN TURN
ffg(a)=1
GOSUB draw
NEXT a
fill COLOR 60/255,70/255,110/255
FOR a=1 TO faces
IF ffg(a)=0 THEN
'triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix,triy count 3
'triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/4)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/4)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/4)+ro
fill poly trix,triy count 3
END IF
NEXT a
RETURN
'Draw A Face Of The Object
draw:
' CROSS PRODUCT CALC \/
vx1 = tx(f1(a))-tx(f2(a))
vy1= ty(f1(a))-ty(f2(a))
vx2 = tx(f3(a))-tx(f2(a))
vy2= ty(f3(a))-ty(f2(a))
n = vx1*vy2-vx2*vy1
IF n<0 THEN
' IF NEGATIVE SURVACE VISIBLE
ffg(a)=1
n=-(n/700)
IF n>220 THEN
n=220
END IF
' LIMIT MAX COLOR
fill COLOR r(a)+n/255,g(a)+n/255,b(a)+n/255
'triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
n=n/4
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix,triy count 3
'Uncomment to have color
'fill COLOR r(a)+n-10,g(a)+n-10,b(a)+n-10
'Comment if color is used
fill color .5,.5,.5
'triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/3)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/3)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/3)+ro
fill poly trix,triy count 3
IF clss(a)=1 THEN
'DRAW BORDER IF CELL SHAD ON
l=n*80
draw COLOR .l,.l,.50+l
'empty triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
draw poly trix,triy count 3
'empty triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/3)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/3)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/3)+ro
draw poly trix,triy count 3
END IF
END IF
RETURN
'Object Rotation and offset
rotate:
'Rotate And Scale Each Point - Store Result
FOR a=1 TO points
x1=x(a)
y1=y(a)
z1=z(a)
'X,Y,Z rotations!
xx=x1
yy=y1*cs(xr)+z1*sn(xr)
zz=z1*cs(xr)-y1*sn(xr)
y1=yy
x1=xx*cs(yr)-zz*sn(yr)
z1=xx*sn(yr)+zz*cs(yr)
zz=z1
xx=x1*cs(zr)-y1*sn(zr)
yy=x1*sn(zr)+y1*cs(zr)
'Apply Perspective!
dv=(zz/18)+1
xx=size*(xx/dv)+sw/2
yy=size*(yy/dv)+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
NEXT a
xr=xr+3
yr=yr+2
zr=zr+3
IF xr>720 THEN
xr=xr-720
END IF
IF yr>720 THEN
yr=yr-720
END IF
IF zr>720 THEN
zr=zr-720
END IF
RETURN
setup:
pi=3.1415
'3D Object Variables
p=0
scx=0
s$=" "
s$=s$&"MORPHING OBJECTS.... "
s$=s$&" EVEN THE COLOR SCHEME I HAVE USED IS A BIT "
s$=s$&"DIFFERENT TO MOST DEMOS.... YOU MAY FIND IT "
s$=s$&"A BIT BRIGHT, I LIKE IT THOUGH..... "
s$=s$&"I'VE TRIED MY BEST TO GIVE THE FACES A KIND OF "
s$=s$&"OILY SHEEN SIMILAR TO THE COLORS YOU'D SEE IF YOU"
s$=s$&" WERE LOOKING AT A THIN PATCH OF OIL ON WATER.. "
size=14
' how big do you want it?
ro=570
points=14
' The amount of points in the object
faces=24
' The Amount of faces in the object
mt=2
mxo=5
DIM ffg(faces+1)
DIM x(points+1),y(points+1),z(points+1)
DIM mx(points+2,mxo+2),my(points+2,mxo+2),mz(points+2,mxo+2)
DIM tx(points+1),ty(points+1),tz(points+1),f1(faces+1),f2(faces+1)
DIM f3(faces+1),f4(faces+1),r(faces+1),g(faces+1),b(faces+1)
DIM clss(faces+1)
DIM trix(4),triy(4)
' Define Sine Tables for faster matrix calculations
DIM cs(1441),sn(1441)
FOR ang=1 TO 1440
cs(ang)=COS(ang*(PI/360))
sn(ang)=SIN(ang*(PI/360))
NEXT ang
' Read in the object's points
FOR a=1 TO points
read x(a)
read y(a)
read z(a)
mx(a,1)=x(a)
my(a,1)=y(a)
mz(a,1)=z(a)
NEXT a
FOR bb=2 TO mxo
FOR a=1 TO points
READ mx(a,bb),my(a,bb),mz(a,bb)
NEXT a
NEXT bb
'Read In Connections and face parameters
FOR a=1 TO faces
READ f1(a),f2(a),f3(a),f4(a),r(a),g(a),b(a),clss(a)
NEXT a
'set rotations x,y,z
xr=3
yr=2
zr=3
''screen area
sw=Screen_Width()
sh=Screen_Height()
'The Object And Face Connection Description As Data!
DATA 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0
DATA 8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
DATA 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5
DATA 0,0,-5,5,0,0,0
DATA 5,0,-5,0,0,0,-5,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,5
DATA 4,-4,-4,4,4,-4,-4,4,-4,-4,-4,-4,0,0,-8,8,0,0,0
DATA 8,0,-8,0,0,0,-8,0,4,-4,4,4,4,4,-4,4,4,-4,-4,4,0,0,8
DATA 2,-5,-5,2,5,-5,-2,5,-5,-2,-5,-5
DATA 0,0,-5,2,0,0,0
DATA 5,0,-2,0,0,0,-5,0,2,-5,5,2,5,5,-2,5,5,-2,-5,5,0,0,5
DATA 1,-5,-5,1,5,-5,-1,5,-5,-1,-5,-5
DATA 0,0,-5,7,0,0,0
DATA 5,0,-7,0,0,0,-5,0,1,-5,5,1,5,5,-1,5,5,-1,-5,5,0,0,5
DATA 10,9,13,13,50,0,0,1
DATA 14,10,13,13,0,50,0,1
DATA 14,13,12,12,0,50,0,1
DATA 8,12,13,13,0,0,50,1
DATA 4,8,13,13,0,0,50,1
DATA 10,14,11,11,0,50,0,1
DATA 10,11,6,6,50,0,50,1
DATA 4,13,9,9,50,0,0,1
DATA 1,4,9,9,50,0,0,1
DATA 1,9,10,10,50,0,0,1
DATA 6,1,10,10,50,0,50,1
DATA 5,4,1,1,0,50,50,1
DATA 8,4,3,3,0,0,50,1
DATA 3,12,8,8,0,0,50,1
DATA 3,4,5,5,0,50,50,1
DATA 7,12,3,3,50,50,0,1
DATA 14,12,11,11,0,50,0,1
DATA 11,12,7,7,50,50,0,1
DATA 6,11,2,2,50,0,50,1
DATA 11,7,2,2,50,50,0,1
DATA 1,6,2,2,50,0,50,1
DATA 2,5,1,1,0,50,50,1
DATA 2,7,3,3,50,50,0,1
DATA 2,3,5,5,0,50,50,1
RETURN
Manimotion v3
-
- Posts: 167
- Joined: Wed Oct 22, 2014 3:26 pm
- My devices: iPhone 4 to 6+,iPad mini to iPad air 2
Manimotion v3
- Attachments
-
- image.jpg (171.65 KiB) Viewed 1691 times
-
- image.jpg (169.29 KiB) Viewed 1691 times
-
- image.jpg (200.02 KiB) Viewed 1691 times
- Mr. Kibernetik
- Site Admin
- Posts: 4786
- Joined: Mon Nov 19, 2012 10:16 pm
- My devices: iPhone, iPad, MacBook
- Location: Russia
- Flag:
Re: Manimotion v3
On iPad I get this:
and also text is moving too fast to read it.
and also text is moving too fast to read it.
-
- Posts: 167
- Joined: Wed Oct 22, 2014 3:26 pm
- My devices: iPhone 4 to 6+,iPad mini to iPad air 2
Re: Manimotion v3
REM 3d Manimotion Demo v4
REM A 3D demo with a twist!
REM iPhone 6 Plus / 8.2 b4
REM very buggy. I'm still working on it.
REM v2 - fixed bugs, floor and lighting.
REM v3 - sound added, background color
REM fixed scroller.
REM v4 - fixed shadow location and scroll
REM speed in setup.
REM enjoy...
def reload
notes load "/Examples/10. Music & Sound/files/test7.mid"
notes play
enddef
reload
graphics
'SET UP ALL VARIABLES
GOSUB setup
rr=rnd(1)
gg=rnd(1)
bb=rnd(1)
cr=1
cb=1
cg=1
'Start Loop
loop:
cr=cr+rr
cg=cg+gg
cb=cb+bb
if cr>255 or cr <1 then rr = -rr
if cg>255 or cg <1 then gg = -gg
if cb>255 or cb <1 then bb = -bb
refresh off
'graphics clear 0,0,0
fd=fad/10
fill COLOR cr/255,cg/255,cb/255
'top back
'triangle 0,0 to sw,sh to 0,sh
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh-90
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle 0,0 to sw,sh-40 to sw,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh-90
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
fill COLOR 170/255,170/255,210/255
'bottom back
'triangle 0,sh-40 to sw,sh to sw,sh-40
trix(0)=0
triy(0)=sh-90
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=sh-90
fill poly trix,triy count 3
'triangle 0,sh-40 to sw,sh to 0,sh
trix(0)=0
triy(0)=sh-90
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
GOSUB rotate 'ROTATE OBJECT
GOSUB construct 'DRAW OBJECT
mh=mh+1
IF mh>25 THEN
GOSUB morph
END IF
IF mh>50 THEN
mt=mt+1
IF mt>mxo THEN
mt=1
END IF
mh=0
END IF
fill COLOR 170/255,170/255,210/255
fill RECT 0,0 to sw,40
draw COLOR 0,0,0
DRAW TEXT "Manimotion Demo" at sw/4,10
draw COLOR 1,1,1
DRAW TEXT "Manimotion Demo" at sw/4,12
draw COLOR 1,1,1
DRAW TEXT MID$(s$,p,67) at scx,38
draw COLOR 0,0,0
DRAW TEXT MID$(s$,p,67) at scx+2,40
scx=scx-scrollspeed 'scroll speed 1-slower, 10 faster
IF scx<-10 THEN
scx=scx+10
p=p+1
IF p>LEN(s$)-1 THEN
p=0
END IF
END IF
refresh on
GOTO loop 'End Loop
RETURN
morph:
FOR a=1 TO points
IF x(a)<mx(a,mt) THEN
x(a)=x(a)+.05
END IF
IF x(a)>mx(a,mt) THEN
x(a)=x(a)-.05
END IF
IF y(a)<my(a,mt) THEN
y(a)=y(a)+.05
END IF
IF y(a)>my(a,mt) THEN
y(a)=y(a)-.05
END IF
IF z(a)<mz(a,mt) THEN
z(a)=z(a)+.05
END IF
IF z(a)>mz(a,mt) THEN
z(a)=z(a)-.05
END IF
NEXT a
RETURN
'Control sub to Draw The Object
construct:
FOR a=1 TO faces
'DO EACH FACE IN TURN
ffg(a)=1
GOSUB draw
NEXT a
fill COLOR 60/255,70/255,110/255
FOR a=1 TO faces
IF ffg(a)=0 THEN
'triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix,triy count 3
'triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/4)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/4)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/4)+ro
fill poly trix,triy count 3
END IF
NEXT a
RETURN
'Draw A Face Of The Object
draw:
' CROSS PRODUCT CALC \/
vx1 = tx(f1(a))-tx(f2(a))
vy1= ty(f1(a))-ty(f2(a))
vx2 = tx(f3(a))-tx(f2(a))
vy2= ty(f3(a))-ty(f2(a))
n = vx1*vy2-vx2*vy1
IF n<0 THEN
' IF NEGATIVE SURVACE VISIBLE
ffg(a)=1
n=-(n/700)
IF n>220 THEN
n=220
END IF
' LIMIT MAX COLOR
fill COLOR r(a)+n/255,g(a)+n/255,b(a)+n/255
'triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
n=n/4
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix,triy count 3
fill COLOR r(a)+n-10,g(a)+n-10,b(a)+n-10
'fill color .5,.5,.5
'triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/3)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/3)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/3)+ro
fill poly trix,triy count 3
IF clss(a)=1 THEN
'DRAW BORDER IF CELL SHAD ON
l=n*80
draw COLOR .l,.l,.50+l
'empty triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
draw poly trix,triy count 3
'empty triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/3)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/3)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/3)+ro
draw poly trix,triy count 3
END IF
END IF
RETURN
'Object Rotation and offset
rotate:
'Rotate And Scale Each Point - Store Result
FOR a=1 TO points
x1=x(a)
y1=y(a)
z1=z(a)
'X,Y,Z rotations!
xx=x1
yy=y1*cs(xr)+z1*sn(xr)
zz=z1*cs(xr)-y1*sn(xr)
y1=yy
x1=xx*cs(yr)-zz*sn(yr)
z1=xx*sn(yr)+zz*cs(yr)
zz=z1
xx=x1*cs(zr)-y1*sn(zr)
yy=x1*sn(zr)+y1*cs(zr)
'Apply Perspective!
dv=(zz/18)+1
xx=size*(xx/dv)+sw/2
yy=size*(yy/dv)+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
NEXT a
xr=xr+3
yr=yr+2
zr=zr+3
IF xr>720 THEN
xr=xr-720
END IF
IF yr>720 THEN
yr=yr-720
END IF
IF zr>720 THEN
zr=zr-720
END IF
RETURN
setup:
'screen area
sw=Screen_Width()
sh=Screen_Height()
pi=3.1415
scrollspeed=1 '1-10
'3D Object Variables
p=0
scx=0
s$=" "
s$=s$&"MORPHING OBJECTS.... "
s$=s$&" EVEN THE COLOR SCHEME I HAVE USED IS A BIT "
s$=s$&"DIFFERENT TO MOST DEMOS.... YOU MAY FIND IT "
s$=s$&"A BIT BRIGHT, I LIKE IT THOUGH..... "
s$=s$&"I'VE TRIED MY BEST TO GIVE THE FACES A KIND OF "
s$=s$&"OILY SHEEN SIMILAR TO THE COLORS YOU'D SEE IF YOU"
s$=s$&" WERE LOOKING AT A THIN PATCH OF OIL ON WATER.. "
size=14 'how big do you want it?
ro=sh+40 'shadow location
points=14 'The amount of points in the object
faces=24 'The Amount of faces in the object
mt=2
mxo=5
DIM ffg(faces+1)
DIM x(points+1),y(points+1),z(points+1)
DIM mx(points+2,mxo+2),my(points+2,mxo+2),mz(points+2,mxo+2)
DIM tx(points+1),ty(points+1),tz(points+1),f1(faces+1),f2(faces+1)
DIM f3(faces+1),f4(faces+1),r(faces+1),g(faces+1),b(faces+1)
DIM clss(faces+1)
DIM trix(4),triy(4)
' Define Sine Tables for faster matrix calculations
DIM cs(1441),sn(1441)
FOR ang=1 TO 1440
cs(ang)=COS(ang*(PI/360))
sn(ang)=SIN(ang*(PI/360))
NEXT ang
' Read in the object's points
FOR a=1 TO points
read x(a)
read y(a)
read z(a)
mx(a,1)=x(a)
my(a,1)=y(a)
mz(a,1)=z(a)
NEXT a
FOR bb=2 TO mxo
FOR a=1 TO points
READ mx(a,bb),my(a,bb),mz(a,bb)
NEXT a
NEXT bb
'Read In Connections and face parameters
FOR a=1 TO faces
READ f1(a),f2(a),f3(a),f4(a),r(a),g(a),b(a),clss(a)
NEXT a
'set rotations x,y,z
xr=3
yr=2
zr=3
'The Object And Face Connection Description As Data!
DATA 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0
DATA 8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
DATA 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5
DATA 0,0,-5,5,0,0,0
DATA 5,0,-5,0,0,0,-5,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,5
DATA 4,-4,-4,4,4,-4,-4,4,-4,-4,-4,-4,0,0,-8,8,0,0,0
DATA 8,0,-8,0,0,0,-8,0,4,-4,4,4,4,4,-4,4,4,-4,-4,4,0,0,8
DATA 2,-5,-5,2,5,-5,-2,5,-5,-2,-5,-5
DATA 0,0,-5,2,0,0,0
DATA 5,0,-2,0,0,0,-5,0,2,-5,5,2,5,5,-2,5,5,-2,-5,5,0,0,5
DATA 1,-5,-5,1,5,-5,-1,5,-5,-1,-5,-5
DATA 0,0,-5,7,0,0,0
DATA 5,0,-7,0,0,0,-5,0,1,-5,5,1,5,5,-1,5,5,-1,-5,5,0,0,5
DATA 10,9,13,13,50,0,0,1
DATA 14,10,13,13,0,50,0,1
DATA 14,13,12,12,0,50,0,1
DATA 8,12,13,13,0,0,50,1
DATA 4,8,13,13,0,0,50,1
DATA 10,14,11,11,0,50,0,1
DATA 10,11,6,6,50,0,50,1
DATA 4,13,9,9,50,0,0,1
DATA 1,4,9,9,50,0,0,1
DATA 1,9,10,10,50,0,0,1
DATA 6,1,10,10,50,0,50,1
DATA 5,4,1,1,0,50,50,1
DATA 8,4,3,3,0,0,50,1
DATA 3,12,8,8,0,0,50,1
DATA 3,4,5,5,0,50,50,1
DATA 7,12,3,3,50,50,0,1
DATA 14,12,11,11,0,50,0,1
DATA 11,12,7,7,50,50,0,1
DATA 6,11,2,2,50,0,50,1
DATA 11,7,2,2,50,50,0,1
DATA 1,6,2,2,50,0,50,1
DATA 2,5,1,1,0,50,50,1
DATA 2,7,3,3,50,50,0,1
DATA 2,3,5,5,0,50,50,1
RETURN
REM A 3D demo with a twist!
REM iPhone 6 Plus / 8.2 b4
REM very buggy. I'm still working on it.
REM v2 - fixed bugs, floor and lighting.
REM v3 - sound added, background color
REM fixed scroller.
REM v4 - fixed shadow location and scroll
REM speed in setup.
REM enjoy...
def reload
notes load "/Examples/10. Music & Sound/files/test7.mid"
notes play
enddef
reload
graphics
'SET UP ALL VARIABLES
GOSUB setup
rr=rnd(1)
gg=rnd(1)
bb=rnd(1)
cr=1
cb=1
cg=1
'Start Loop
loop:
cr=cr+rr
cg=cg+gg
cb=cb+bb
if cr>255 or cr <1 then rr = -rr
if cg>255 or cg <1 then gg = -gg
if cb>255 or cb <1 then bb = -bb
refresh off
'graphics clear 0,0,0
fd=fad/10
fill COLOR cr/255,cg/255,cb/255
'top back
'triangle 0,0 to sw,sh to 0,sh
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh-90
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle 0,0 to sw,sh-40 to sw,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh-90
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
fill COLOR 170/255,170/255,210/255
'bottom back
'triangle 0,sh-40 to sw,sh to sw,sh-40
trix(0)=0
triy(0)=sh-90
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=sh-90
fill poly trix,triy count 3
'triangle 0,sh-40 to sw,sh to 0,sh
trix(0)=0
triy(0)=sh-90
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
GOSUB rotate 'ROTATE OBJECT
GOSUB construct 'DRAW OBJECT
mh=mh+1
IF mh>25 THEN
GOSUB morph
END IF
IF mh>50 THEN
mt=mt+1
IF mt>mxo THEN
mt=1
END IF
mh=0
END IF
fill COLOR 170/255,170/255,210/255
fill RECT 0,0 to sw,40
draw COLOR 0,0,0
DRAW TEXT "Manimotion Demo" at sw/4,10
draw COLOR 1,1,1
DRAW TEXT "Manimotion Demo" at sw/4,12
draw COLOR 1,1,1
DRAW TEXT MID$(s$,p,67) at scx,38
draw COLOR 0,0,0
DRAW TEXT MID$(s$,p,67) at scx+2,40
scx=scx-scrollspeed 'scroll speed 1-slower, 10 faster
IF scx<-10 THEN
scx=scx+10
p=p+1
IF p>LEN(s$)-1 THEN
p=0
END IF
END IF
refresh on
GOTO loop 'End Loop
RETURN
morph:
FOR a=1 TO points
IF x(a)<mx(a,mt) THEN
x(a)=x(a)+.05
END IF
IF x(a)>mx(a,mt) THEN
x(a)=x(a)-.05
END IF
IF y(a)<my(a,mt) THEN
y(a)=y(a)+.05
END IF
IF y(a)>my(a,mt) THEN
y(a)=y(a)-.05
END IF
IF z(a)<mz(a,mt) THEN
z(a)=z(a)+.05
END IF
IF z(a)>mz(a,mt) THEN
z(a)=z(a)-.05
END IF
NEXT a
RETURN
'Control sub to Draw The Object
construct:
FOR a=1 TO faces
'DO EACH FACE IN TURN
ffg(a)=1
GOSUB draw
NEXT a
fill COLOR 60/255,70/255,110/255
FOR a=1 TO faces
IF ffg(a)=0 THEN
'triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix,triy count 3
'triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/4)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/4)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/4)+ro
fill poly trix,triy count 3
END IF
NEXT a
RETURN
'Draw A Face Of The Object
draw:
' CROSS PRODUCT CALC \/
vx1 = tx(f1(a))-tx(f2(a))
vy1= ty(f1(a))-ty(f2(a))
vx2 = tx(f3(a))-tx(f2(a))
vy2= ty(f3(a))-ty(f2(a))
n = vx1*vy2-vx2*vy1
IF n<0 THEN
' IF NEGATIVE SURVACE VISIBLE
ffg(a)=1
n=-(n/700)
IF n>220 THEN
n=220
END IF
' LIMIT MAX COLOR
fill COLOR r(a)+n/255,g(a)+n/255,b(a)+n/255
'triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
n=n/4
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix,triy count 3
fill COLOR r(a)+n-10,g(a)+n-10,b(a)+n-10
'fill color .5,.5,.5
'triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/3)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/3)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/3)+ro
fill poly trix,triy count 3
IF clss(a)=1 THEN
'DRAW BORDER IF CELL SHAD ON
l=n*80
draw COLOR .l,.l,.50+l
'empty triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
draw poly trix,triy count 3
'empty triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
trix(0)=tx(f1(a))
triy(0)=(-ty(f1(a))/3)+ro
trix(1)=tx(f2(a))
triy(1)=(-ty(f2(a))/3)+ro
trix(2)=tx(f3(a))
triy(2)=(-ty(f3(a))/3)+ro
draw poly trix,triy count 3
END IF
END IF
RETURN
'Object Rotation and offset
rotate:
'Rotate And Scale Each Point - Store Result
FOR a=1 TO points
x1=x(a)
y1=y(a)
z1=z(a)
'X,Y,Z rotations!
xx=x1
yy=y1*cs(xr)+z1*sn(xr)
zz=z1*cs(xr)-y1*sn(xr)
y1=yy
x1=xx*cs(yr)-zz*sn(yr)
z1=xx*sn(yr)+zz*cs(yr)
zz=z1
xx=x1*cs(zr)-y1*sn(zr)
yy=x1*sn(zr)+y1*cs(zr)
'Apply Perspective!
dv=(zz/18)+1
xx=size*(xx/dv)+sw/2
yy=size*(yy/dv)+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
NEXT a
xr=xr+3
yr=yr+2
zr=zr+3
IF xr>720 THEN
xr=xr-720
END IF
IF yr>720 THEN
yr=yr-720
END IF
IF zr>720 THEN
zr=zr-720
END IF
RETURN
setup:
'screen area
sw=Screen_Width()
sh=Screen_Height()
pi=3.1415
scrollspeed=1 '1-10
'3D Object Variables
p=0
scx=0
s$=" "
s$=s$&"MORPHING OBJECTS.... "
s$=s$&" EVEN THE COLOR SCHEME I HAVE USED IS A BIT "
s$=s$&"DIFFERENT TO MOST DEMOS.... YOU MAY FIND IT "
s$=s$&"A BIT BRIGHT, I LIKE IT THOUGH..... "
s$=s$&"I'VE TRIED MY BEST TO GIVE THE FACES A KIND OF "
s$=s$&"OILY SHEEN SIMILAR TO THE COLORS YOU'D SEE IF YOU"
s$=s$&" WERE LOOKING AT A THIN PATCH OF OIL ON WATER.. "
size=14 'how big do you want it?
ro=sh+40 'shadow location
points=14 'The amount of points in the object
faces=24 'The Amount of faces in the object
mt=2
mxo=5
DIM ffg(faces+1)
DIM x(points+1),y(points+1),z(points+1)
DIM mx(points+2,mxo+2),my(points+2,mxo+2),mz(points+2,mxo+2)
DIM tx(points+1),ty(points+1),tz(points+1),f1(faces+1),f2(faces+1)
DIM f3(faces+1),f4(faces+1),r(faces+1),g(faces+1),b(faces+1)
DIM clss(faces+1)
DIM trix(4),triy(4)
' Define Sine Tables for faster matrix calculations
DIM cs(1441),sn(1441)
FOR ang=1 TO 1440
cs(ang)=COS(ang*(PI/360))
sn(ang)=SIN(ang*(PI/360))
NEXT ang
' Read in the object's points
FOR a=1 TO points
read x(a)
read y(a)
read z(a)
mx(a,1)=x(a)
my(a,1)=y(a)
mz(a,1)=z(a)
NEXT a
FOR bb=2 TO mxo
FOR a=1 TO points
READ mx(a,bb),my(a,bb),mz(a,bb)
NEXT a
NEXT bb
'Read In Connections and face parameters
FOR a=1 TO faces
READ f1(a),f2(a),f3(a),f4(a),r(a),g(a),b(a),clss(a)
NEXT a
'set rotations x,y,z
xr=3
yr=2
zr=3
'The Object And Face Connection Description As Data!
DATA 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0
DATA 8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
DATA 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5
DATA 0,0,-5,5,0,0,0
DATA 5,0,-5,0,0,0,-5,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,5
DATA 4,-4,-4,4,4,-4,-4,4,-4,-4,-4,-4,0,0,-8,8,0,0,0
DATA 8,0,-8,0,0,0,-8,0,4,-4,4,4,4,4,-4,4,4,-4,-4,4,0,0,8
DATA 2,-5,-5,2,5,-5,-2,5,-5,-2,-5,-5
DATA 0,0,-5,2,0,0,0
DATA 5,0,-2,0,0,0,-5,0,2,-5,5,2,5,5,-2,5,5,-2,-5,5,0,0,5
DATA 1,-5,-5,1,5,-5,-1,5,-5,-1,-5,-5
DATA 0,0,-5,7,0,0,0
DATA 5,0,-7,0,0,0,-5,0,1,-5,5,1,5,5,-1,5,5,-1,-5,5,0,0,5
DATA 10,9,13,13,50,0,0,1
DATA 14,10,13,13,0,50,0,1
DATA 14,13,12,12,0,50,0,1
DATA 8,12,13,13,0,0,50,1
DATA 4,8,13,13,0,0,50,1
DATA 10,14,11,11,0,50,0,1
DATA 10,11,6,6,50,0,50,1
DATA 4,13,9,9,50,0,0,1
DATA 1,4,9,9,50,0,0,1
DATA 1,9,10,10,50,0,0,1
DATA 6,1,10,10,50,0,50,1
DATA 5,4,1,1,0,50,50,1
DATA 8,4,3,3,0,0,50,1
DATA 3,12,8,8,0,0,50,1
DATA 3,4,5,5,0,50,50,1
DATA 7,12,3,3,50,50,0,1
DATA 14,12,11,11,0,50,0,1
DATA 11,12,7,7,50,50,0,1
DATA 6,11,2,2,50,0,50,1
DATA 11,7,2,2,50,50,0,1
DATA 1,6,2,2,50,0,50,1
DATA 2,5,1,1,0,50,50,1
DATA 2,7,3,3,50,50,0,1
DATA 2,3,5,5,0,50,50,1
RETURN