home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 4: Demo 1
/
almathera_demo1.bin
/
amos
/
3dforglasses.amos
/
3dforglasses.amosSourceCode
next >
Wrap
AMOS Source Code
|
1995-03-16
|
4KB
|
165 lines
Screen Open 0,320,256,4,Lowres : Flash Off : Curs Off : Hide On : Cls 0
Palette 0,$FFC : Pen 1 : Paper 0
Locate 1,2 : Centre "3D Vector Graphics for 3D Glasses."
Locate 1,3 : Centre "=================================="
Locate 1,5 : Centre "By Dominic Ramsey"
Locate 0,10 : Centre "To use this program, you will need a"
Locate 1,11 : Centre "pair of red/blue or red/green"
Locate 1,12 : Centre "3D glasses. The program is currently"
Locate 1,13 : Centre "set up for red/blue glasses."
Locate 1,15 : Centre "For best results, adjust the"
Locate 1,16 : Centre "brightness of your monitor and"
Locate 1,17 : Centre " your viewing distance."
Locate 1,28 : Centre "Press a key to start."
Wait Key
Music 1 : Led Off
Cls 0
Gr Writing 3
Dim X#(20),Y#(20),Z#(20),XX(20,2),YY(20,2)
Dim F1(20),F2(20)
'
'set Degree mode and precalculate values for sin and cos of
' rotation angle ( 2 degrees)
'
Degree : CS#=Cos(2)*1.0006 : SN#=Sin(2)*1.0006
'
' D = Vanishing point on Z Axis
'
' Try changing D. The Lower the value, the closer the observer is to the
' object.
D=5
' Set for manual screen swapping
Double Buffer : Autoback 0
M:
MN=0 : NXTOBJ=1
Restore
RD:
Fade 2 : Wait 30 : Cls 0 : Screen Swap
' set palette according to 3D glasses
' For Red - blue glasses
Fade 2,$0,$A00,$A0A,$A
' For Red - reen glasses change above line to Fade 2,$0,$a00,$aa0,$0a
If NXTOBJ=0 Then Goto M
MN=0
Read NP,NL
L=NL+1 : P=NP+1
For A=1 To NP
Read X#(A),Y#(A),Z#(A)
Next
'
For A=1 To NL
Read F1(A),F2(A)
Next
Read NXTOBJ
'0 if no more objs
'
' Data for ponts in 3D space (X,Y,Z)
' must range from -1 to +1
'
'
CDAT:
' Cube
Data 8,12
Data -1,-1,-1,1,-1,-1,1,1,-1,-1,1,-1
Data -1,-1,1,1,-1,1,1,1,1,-1,1,1
Data 1,2,2,3,3,4,4,1,5,6,6,7,7,8,8,5,1,5,2,6,3,7,4,8
Data 1
'House
Data 9,16
Data -1,-1,-1,1,-1,-1,1,1,-1,-1,1,-1
Data -1,-1,0.5,1,-1,0.5,1,1,0.5,-1,1,0.5,0,0,1
Data 1,2,2,3,3,4,4,1,5,6,6,7,7,8,8,5,1,5,2,6,3,7,4,8,5,9,6,9,7,9,8,9
Data 1
'Pyramid
Data 5,8
Data 0,1,0,-1,-1,-1,1,-1,-1,1,-1,1,-1,-1,1
Data 1,2,1,3,1,4,1,5,2,3,3,4,4,5,5,2
Data 1
'DR
Data 15,13
Data -1,1,0,-0.6,1,0,-0.2,0.6,0,-0.2,-0.6,0,-0.6,-1,0,-1,-1,0
Data 0,1,0,0.8,1,0,1,0.6,0,1,0.4,0,0.8,0,0,0,0,0,0,-1,0,0.6,0,0,1,-1,0
Data 1,2,2,3,3,4,4,5,5,6,6,1
Data 7,8,8,9,9,10,10,11,11,12,7,13,14,15
Data 0
' No more objs
'ROTATIONS
'=========
'The simple routine below rotates around 2 of 3 axes at once.
'The formulae for rotation are simple. See ROTX,ROTY,ROTZ
'to see how its done.
'
DX=-70
Repeat
ROT:
Inc MN
If MN>250 Then Goto RD
Add R,1,1 To 100
A=1 : While A<P
If R<33
Gosub ROTX
Gosub ROTY
Else If R>32 and R<66
Gosub ROTZ
Gosub ROTY
Else
Gosub ROTX
Gosub ROTZ
End If
End If
Inc A
Wend
'DISPLAY OBJECT
A=1
While A<P
'convert Z factor of a point into x and y coords
ZZ#=Z#(A)-1
' Move object out of screen
XX(A,1)=X#(A)*D/(ZZ#+D)*50
YY(A,1)=Y#(A)*D/(ZZ#+D)*50
'Second image
XX(A,2)=(X#(A)+(ZZ#/20)-0.3)*D/(ZZ#+D)*50
YY(A,2)=Y#(A)*D/(ZZ#+D)*50
' translation to middle of screen.
XX(A,1)=XX(A,1)+170
YY(A,1)=YY(A,1)+128
'Second image
XX(A,2)=XX(A,2)+170
YY(A,2)=YY(A,2)+128
Inc A
Wend
Cls 0
A=1
' draw lines
While A<L
F1=F1(A) : F2=F2(A)
Gr Writing 0
Ink 1,
Draw XX(F1,1),YY(F1,1) To XX(F2,1),YY(F2,1)
Gr Writing 2
Draw XX(F1,2),YY(F1,2) To XX(F2,2),YY(F2,2)
Inc A
Wend
'
Screen Swap
Until Mouse Key
Music Off : End
'
'
' Rotation Subroutines
'
'
ROTZ:
X#(A)=X#(A)*CS#-Y#(A)*SN#
Y#(A)=Y#(A)*CS#+X#(A)*SN#
Return
'
ROTY:
X#(A)=X#(A)*CS#-Z#(A)*SN#
Z#(A)=Z#(A)*CS#+X#(A)*SN#
Return
'
ROTX:
Y#(A)=Y#(A)*CS#-Z#(A)*SN#
Z#(A)=Z#(A)*CS#+Y#(A)*SN#
Return