home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / various / 3d_cube.amos / 3d_cube.amosSourceCode next >
AMOS Source Code  |  1993-01-08  |  3KB  |  127 lines
  1. 'Cube Demo by David Seeto
  2. 'Angles stored in array for faster operation 
  3. 'Only four vertices used because the solid is a square 
  4. 'The viewer only sees to faces at a time,therefore speeding up hidden surface removal
  5. 'Note how the cube changes shade as it rotates.  
  6. 'Isn't this great!!  
  7. Procedure TRANSFORM[X#,F#]
  8.    T#=X#*F#
  9.    If T#<0.0
  10.       C=-Int(Abs(T#))
  11.    Else C=Int(T#)
  12.    End If 
  13. End Proc[C]
  14. Procedure NEWDIR
  15.    C#=Rnd(60)+40
  16. End Proc[C#]
  17. Procedure CONVERT2D
  18.    For I=0 To NRVERTICIES-1
  19.       F#=1000.0/(DISTANCE#-Z#(I))
  20.       TRANSFORM[X#(I),F#]
  21.       X2D#(I)=Param
  22.       TRANSFORM[Y#(I),F#]
  23.       Y2D#(I)=Param
  24.    Next I
  25. End Proc
  26. Procedure DCUBE
  27.    LEFT=X2D#(0) : I=0
  28.    For VERTEX=1 To NRVERTICIES-1
  29.       If X2D#(VERTEX)<LEFT
  30.          LEFT=X2D#(VERTEX)
  31.          I=VERTEX
  32.       End If 
  33.    Next VERTEX
  34.    J=(I+1) mod NRVERTICIES
  35.    K=(I+2) mod NRVERTICIES
  36.    Screen Swap : Wait Vbl : Cls 0
  37.    If X2D#(J)>=X2D#(K) Then RIGHTOBSCURED=True Else RIGHTOBSCURED=False
  38.    If RIGHTOBSCURED Then Ink 2 Else Ink 1
  39.    Polygon CX+X2D#(I),CY+Y2D#(I) To CX+X2D#(J),CY+Y2D#(J) To CX+X2D#(J),CY-Y2D#(J) To CX+X2D#(I),CY-Y2D#(I) To CX+X2D#(I),CY+Y2D#(I)
  40.    If Not RIGHTOBSCURED
  41.       Ink 2
  42.       Polygon CX+X2D#(J),CY+Y2D#(J) To CX+X2D#(K),CY+Y2D#(K) To CX+X2D#(K),CY-Y2D#(K) To CX+X2D#(J),CY-Y2D#(J)
  43.    End If 
  44.    Colour 2,Val(Hex$(ANGLE/8+4))
  45.    Colour 1,Val(Hex$((89-ANGLE)/8+4))
  46. End Proc
  47. Procedure YROTATION
  48.    Inc MCOUNT
  49.    If MCOUNT>=MX
  50.       MCOUNT=0 : 
  51.       Add PHI,PHIDIR
  52.       If(PHI<=-LMANGLE) and(PHIDIR<0) or(PHI>=LMANGLE) and(PHIDIR>0)
  53.          LMANGLE=Rnd(MANGLE/2-1)+MANGLE/2-1
  54.          PHIDIR=-PHIDIR
  55.       End If 
  56.    End If 
  57.    Add ANGLE,PHI
  58.    ANGLE=(ANGLE+90) mod 90
  59.    CPHI#=COPHI#(Abs(PHI))
  60.    If PHI<0
  61.       SPHI#=-SIPHI#(Abs(PHI))
  62.    Else SPHI#=SIPHI#(PHI)
  63.    End If 
  64.    For I=0 To NRVERTICIES-1
  65.       LX#=X#(I) : LZ#=Z#(I)
  66.       X#(I)=LX#*CPHI#-LZ#*SPHI#
  67.       Z#(I)=LZ#*CPHI#+LX#*SPHI#
  68.    Next I
  69. End Proc
  70. Procedure CALC[N]
  71.    While N>0
  72.       YROTATION
  73.       CONVERT2D
  74.       DCUBE
  75.       Dec N
  76.    Wend 
  77. End Proc
  78. Screen Open 0,320,200,16,Lowres
  79. Hide : Cls 0
  80. Unpack 16 To 1
  81. Wait Key 
  82. Fade 10 : Wait 150
  83. Screen Open 0,320,200,4,Lowres
  84. Curs Off : Cls 0 : Flash Off 
  85. Double Buffer : Autoback 0 : Screen Swap 
  86. CX=160 : CY=100
  87. Global CX,CY
  88. MANGLE=20
  89. MX=8
  90. Dim SIPHI#(MANGLE),COPHI#(MANGLE)
  91. Global SIPHI#(),COPHI#()
  92. Global PHI,PHIDIR,MANGLE,MX,LMANGLE,ANGLE,MCOUNT
  93. PHI=0 : PHIDIR=1
  94. MX=8
  95. Degree 
  96. LMANGLE=Rnd(MANGLE/2-1)+MANGLE/2-1
  97. ANGLE=0 : MCOUNT=MX
  98. For I=0 To MANGLE
  99.    SIPHI#(I)=Sin(I)
  100.    COPHI#(I)=Cos(I)
  101. Next I
  102. DISTANCE#=6500.0
  103. NRVERTICIES=4
  104. Global DISTANCE#,NRVERTICIES
  105. Dim X#(NRVERTICIES-1),Y#(NRVERTICIES-1),Z#(NRVERTICIES-1)
  106. Dim X2D#(NRVERTICIES-1),Y2D#(NRVERTICIES-1)
  107. Global X#(),Y#(),Z#(),X2D#(),Y2D#()
  108. X#(0)=-150.0 : Y#(0)=150.0 : Z#(0)=150.0
  109. X#(1)=150.0 : Y#(1)=150.0 : Z#(1)=150.0
  110. X#(2)=150.0 : Y#(2)=150.0 : Z#(2)=-150.0
  111. X#(3)=-150.0 : Y#(3)=150.0 : Z#(3)=-150.0
  112. CALC[40]
  113. NEWDIR
  114. D#=Param#
  115. For I=1 To 500
  116.    CALC[1]
  117.    DISTANCE#=DISTANCE#+D#
  118.    If DISTANCE#<=1800.0
  119.       NEWDIR
  120.       D#=Param# : CALC[Rnd(30)+20]
  121.    End If 
  122.    If DISTANCE#>=6500.0
  123.       NEWDIR
  124.       D#=-Param# : CALC[Rnd(30)+20]
  125.    End If 
  126. Next I
  127. End