graphics/3D/!.bas

   1 ' 3D Wireframe Exclamation mark
   2 ' Author: Svjatoslav Agejenko
   3 ' Use keys:
   4 '   Up, Down, Left, Right, w, z - rotate
   5 '   <space> - speed down
   6 '   q - quit
   7
   8 DECLARE SUB GetCoordinates ()
   9 DECLARE SUB ScaleCoordinates ()
  10 DECLARE SUB Render3D ()
  11 DECLARE SUB CalculateSineCosine ()
  12
  13 DefInt A-Z
  14 Dim Shared Xn(100), Yn(100), Zn(100)
  15 Dim Shared Xs1(100), Ys1(100), Xe1(100), Ye1(100)
  16 Dim Shared x(100), y(100), z(100), pointers1(100), pointers2(100)
  17 Dim Shared Cosine&(360), Sine&(360)
  18 Dim Shared numPoints, numLines
  19 Dim Shared rotationX, rotationY
  20 rotationX = 0
  21 rotationY = 0
  22
  23 Screen 12
  24 Cls
  25 CalculateSineCosine
  26 GetCoordinates
  27 ScaleCoordinates
  28 Render3D
  29
  30 ' Vertex data
  31 Data 5,-60,-10
  32 Data 15,-50,-10
  33 Data 15,0,-10
  34 Data 5,10,-10
  35 Data -5,10,-10
  36 Data -15,0,-10
  37 Data -15,-50,-10
  38 Data -5,-60,-10
  39 Data 5,-60,10
  40 Data 15,-50,10
  41 Data 15,0,10
  42 Data 5,10,10
  43 Data -5,10,10
  44 Data -15,0,10
  45 Data -15,-50,10
  46 Data -5,-60,10
  47 Data 5,20,10
  48 Data 15,30,10
  49 Data 15,40,10
  50 Data 5,50,10
  51 Data -5,50,10
  52 Data -15,40,10
  53 Data -15,30,10
  54 Data -5,20,10
  55 Data 5,20,-10
  56 Data 15,30,-10
  57 Data 15,40,-10
  58 Data 5,50,-10
  59 Data -5,50,-10
  60 Data -15,40,-10
  61 Data -15,30,-10
  62 Data -5,20,-10
  63 Data 999,999,999
  64
  65 ' Line data
  66 Data 0,1
  67 Data 1,2
  68 Data 2,3
  69 Data 3,4
  70 Data 4,5
  71 Data 5,6
  72 Data 6,7
  73 Data 7,0
  74 Data 8,9
  75 Data 9,10
  76 Data 10,11
  77 Data 11,12
  78 Data 12,13
  79 Data 13,14
  80 Data 14,15
  81 Data 15,8
  82 Data 0,8
  83 Data 1,9
  84 Data 2,10
  85 Data 3,11
  86 Data 4,12
  87 Data 5,13
  88 Data 6,14
  89 Data 7,15
  90 Data 16,17
  91 Data 17,18
  92 Data 18,19
  93 Data 19,20
  94 Data 20,21
  95 Data 21,22
  96 Data 22,23
  97 Data 23,16
  98 Data 24,25
  99 Data 25,26
 100 Data 26,27
 101 Data 27,28
 102 Data 28,29
 103 Data 29,30
 104 Data 30,31
 105 Data 31,24
 106 Data 24,16
 107 Data 25,17
 108 Data 26,18
 109 Data 27,19
 110 Data 28,20
 111 Data 29,21
 112 Data 30,22
 113 Data 31,23
 114 Data 999,999
 115
 116 Sub CalculateSineCosine
 117     ' Precalculate sine and cosine values for faster computation
 118     For angle! = 0 To 359 / 57.29577951# Step 1 / 57.29577951#
 119         Cosine&(angle) = Int(.5 + Cos(angle!) * 1024)
 120         Sine&(angle) = Int(.5 + Sin(angle!) * 1024)
 121         angle = angle + 1
 122     Next
 123 End Sub
 124
 125 Sub GetCoordinates
 126     ' Read vertex coordinates from DATA statements
 127     For i = 0 To 10000
 128         Read x(i), y(i), z(i)
 129         If x(i) = 999 Then x(i) = 0: y(i) = 0: z(i) = 0: GoTo EndVertexData
 130     Next
 131     EndVertexData:
 132     numPoints = i
 133
 134     ' Read line data from DATA statements
 135     For i = 0 To 10000
 136         Read pointers1(i), pointers2(i)
 137         If pointers1(i) = 999 Then GoTo EndLineData
 138     Next
 139     EndLineData:
 140     numLines = i
 141 End Sub
 142
 143 Sub ScaleCoordinates
 144     ' Scale coordinates to fit the screen
 145     maxValue = 0
 146     For i = 0 To numPoints
 147         If Abs(x(i)) > maxValue Then maxValue = Abs(x(i))
 148         If Abs(y(i)) > maxValue Then maxValue = Abs(y(i))
 149         If Abs(z(i)) > maxValue Then maxValue = Abs(z(i))
 150     Next i
 151     scaleFactor = 100 / maxValue
 152     For i = 0 To numPoints
 153         x(i) = x(i) * scaleFactor
 154         y(i) = y(i) * scaleFactor
 155         z(i) = z(i) * scaleFactor
 156     Next i
 157 End Sub
 158
 159 Sub Render3D
 160     Do
 161         ' Update rotation angles
 162         rotationX = rotationX + dx
 163         rotationY = rotationY + dy
 164         rotationZ = rotationZ + dz
 165         Sound 0, 1
 166
 167         ' Wrap rotation angles within 0 to 359 degrees
 168         If rotationX <= 0 Then rotationX = rotationX + 360
 169         If rotationY <= 0 Then rotationY = rotationY + 360
 170         If rotationZ <= 0 Then rotationZ = rotationZ + 360
 171         If rotationX >= 360 Then rotationX = rotationX - 360
 172         If rotationY >= 360 Then rotationY = rotationY - 360
 173         If rotationZ >= 360 Then rotationZ = rotationZ - 360
 174
 175         ' Get sine and cosine values for rotation angles
 176         cosX& = Cosine&(rotationX): sinX& = Sine&(rotationX)
 177         cosY& = Cosine&(rotationY): sinY& = Sine&(rotationY)
 178         cosZ& = Cosine&(rotationZ): sinZ& = Sine&(rotationZ)
 179
 180         ' Rotate and project vertices
 181         For i = 0 To numPoints - 1
 182             Xo = x(i): Yo = y(i): Zo = z(i)
 183             X1 = (Xo * cosX& - Yo * sinX&) \ 1024
 184             Y1 = (Xo * sinX& + Yo * cosX&) \ 1024
 185             X2& = (X1 * cosY& - Zo * sinY&) \ 1024
 186             Z1 = (X1 * sinY& + Zo * cosY&) \ 1024
 187             Y2& = (Y1 * cosZ& - Z1 * sinZ&) \ 1024
 188             Z2 = (Y1 * sinZ& + Z1 * cosZ&) \ 1024
 189             Z2 = Z2 + 300
 190             Xn(i) = 320 + (X2& / Z2 * 500)
 191             Yn(i) = 240 + (Y2& / Z2 * 500)
 192         Next
 193
 194         ' Draw lines between vertices
 195         For i = 0 To numLines - 1
 196             startVertex = pointers1(i)
 197             endVertex = pointers2(i)
 198             Xn = Xn(startVertex)
 199             Yn = Yn(startVertex)
 200             X1 = Xn(endVertex)
 201             Y1 = Yn(endVertex)
 202             Line (Xs1(i), Ys1(i))-(Xe1(i), Ye1(i)), 0
 203             Line (X1, Y1)-(Xn, Yn), 15
 204             Xs1(i) = X1: Ys1(i) = Y1
 205             Xe1(i) = Xn: Ye1(i) = Yn
 206         Next
 207
 208         ' Handle user input
 209         K$ = InKey$
 210         If K$ <> "" Then
 211             Select Case K$
 212                 Case Chr$(0) + Chr$(72)  ' Up arrow
 213                     dx = dx + 1
 214                 Case Chr$(0) + Chr$(80)  ' Down arrow
 215                     dx = dx - 1
 216                 Case Chr$(0) + Chr$(75)  ' Left arrow
 217                     dy = dy - 1
 218                 Case Chr$(0) + Chr$(77)  ' Right arrow
 219                     dy = dy + 1
 220                 Case "w"
 221                     dz = dz - 1
 222                 Case "z"
 223                     dz = dz + 1
 224                 Case " "  ' Space bar
 225                     dx = dx / 2
 226                     dy = dy / 2
 227                     dz = dz / 2
 228                 Case Chr$(27)  ' Escape key
 229                     System
 230             End Select
 231         End If
 232     Loop
 233 End Sub