-' Svjatoslav Agejenko\r
-' Use keys:\r
-' Up, Down, Left, Right, w, z - rotate\r
-' <space> - speed down\r
-' q - quit\r
-\r
-DECLARE SUB getcor ()\r
-DECLARE SUB mulcor ()\r
-DECLARE SUB nait3d ()\r
-DECLARE SUB calcsin ()\r
-DefInt A-Z\r
-Dim Shared Xn(100), Yn(100), Zn(100)\r
-Dim Shared Xs1(100), Ys1(100), Xe1(100), Ye1(100)\r
-Dim Shared x(100), y(100), z(100), pointers1(100), pointers2(100)\r
-Dim Shared Cosine&(360), Sine&(360)\r
-Dim Shared np, nl\r
-Dim Shared jrp, jrl\r
-jrp = 0\r
-jrl = 0\r
-\r
-\r
-Screen 12\r
-Cls\r
-\r
-\r
-calcsin\r
-getcor\r
-mulcor\r
-nait3d\r
-\r
-\r
-\r
-\r
-Data 5,-60,-10\r
-Data 15,-50,-10\r
-Data 15,0,-10\r
-Data 5,10,-10\r
-Data -5,10,-10\r
-Data -15,0,-10\r
-Data -15,-50,-10\r
-Data -5,-60,-10\r
-\r
-Data 5,-60,10\r
-Data 15,-50,10\r
-Data 15,0,10\r
-Data 5,10,10\r
-Data -5,10,10\r
-Data -15,0,10\r
-Data -15,-50,10\r
-Data -5,-60,10\r
-\r
-Data 5,20,10\r
-Data 15,30,10\r
-Data 15,40,10\r
-Data 5,50,10\r
-Data -5,50,10\r
-Data -15,40,10\r
-Data -15,30,10\r
-Data -5,20,10\r
-\r
-Data 5,20,-10\r
-Data 15,30,-10\r
-Data 15,40,-10\r
-Data 5,50,-10\r
-Data -5,50,-10\r
-Data -15,40,-10\r
-Data -15,30,-10\r
-Data -5,20,-10\r
-\r
-Data 999,999,999\r
-\r
-Data 0,1\r
-Data 1,2\r
-Data 2,3\r
-Data 3,4\r
-Data 4,5\r
-Data 5,6\r
-Data 6,7\r
-Data 7,0\r
-\r
-Data 8,9\r
-Data 9,10\r
-Data 10,11\r
-Data 11,12\r
-Data 12,13\r
-Data 13,14\r
-Data 14,15\r
-Data 15,8\r
-\r
-\r
-Data 0,8\r
-Data 1,9\r
-Data 2,10\r
-Data 3,11\r
-Data 4,12\r
-Data 5,13\r
-Data 6,14\r
-Data 7,15\r
-\r
-Data 16,17\r
-Data 17,18\r
-Data 18,19\r
-Data 19,20\r
-Data 20,21\r
-Data 21,22\r
-Data 22,23\r
-Data 23,16\r
-\r
-\r
-Data 24,25\r
-Data 25,26\r
-Data 26,27\r
-Data 27,28\r
-Data 28,29\r
-Data 29,30\r
-Data 30,31\r
-Data 31,24\r
-\r
-Data 24,16\r
-Data 25,17\r
-Data 26,18\r
-Data 27,19\r
-Data 28,20\r
-Data 29,21\r
-Data 30,22\r
-Data 31,23\r
-\r
-Data 999,999\r
-\r
-Sub calcsin\r
- For a! = 0 To 359 / 57.29577951# Step 1 / 57.29577951#\r
- Cosine&(a) = Int(.5 + Cos(a!) * 1024)\r
- Sine&(a) = Int(.5 + Sin(a!) * 1024)\r
- a = a + 1\r
- Next\r
-End Sub\r
-\r
-Sub getcor\r
- For a = 0 To 10000\r
- Read x(a), y(a), z(a)\r
- If x(a) = 999 Then x(a) = 0: y(a) = 0: z(a) = 0: GoTo 1\r
- Next\r
- 1\r
- np = a\r
-\r
- For a = 0 To 10000\r
- Read pointers1(a), pointers2(a)\r
- If pointers1(a) = 999 Then GoTo 2\r
- Next\r
- 2\r
- nl = a\r
-\r
-End Sub\r
-\r
-Sub mulcor\r
- suur = 0\r
- For a = 0 To np\r
- If Abs(x(a)) > suur Then suur = Abs(x(a))\r
- If Abs(y(a)) > suur Then suur = Abs(y(a))\r
- If Abs(z(a)) > suur Then suur = Abs(z(a))\r
- Next a\r
- ksuur = 100 / suur\r
-\r
- For a = 0 To np\r
- x(a) = x(a) * ksuur\r
- y(a) = y(a) * ksuur\r
- z(a) = z(a) * ksuur\r
- Next a\r
-End Sub\r
-\r
-Sub nait3d\r
-\r
- Do\r
-\r
- Deg1 = Deg1 + d1\r
- Deg2 = Deg2 + d2\r
- Deg3 = Deg3 + d3\r
-\r
- sound 0,1\r
-\r
- If Deg1 <= 0 Then Deg1 = Deg1 + 360\r
- If Deg2 <= 0 Then Deg2 = Deg2 + 360\r
- If Deg3 <= 0 Then Deg3 = Deg3 + 360\r
-\r
- If Deg1 >= 360 Then Deg1 = Deg1 - 360\r
- If Deg2 >= 360 Then Deg2 = Deg2 - 360\r
- If Deg3 >= 360 Then Deg3 = Deg3 - 360\r
-\r
- C1& = Cosine&(Deg1): S1& = Sine&(Deg1)\r
- C2& = Cosine&(Deg2): S2& = Sine&(Deg2)\r
- C3& = Cosine&(Deg3): S3& = Sine&(Deg3)\r
-\r
- For a = 0 To np - 1\r
- R = a\r
- Xo = x(R): Yo = y(R): Zo = z(R)\r
-\r
- X1 = (Xo * C1& - Yo * S1&) \ 1024\r
- Y1 = (Xo * S1& + Yo * C1&) \ 1024\r
-\r
- X2& = (X1 * C2& - Zo * S2&) \ 1024\r
- z1 = (X1 * S2& + Zo * C2&) \ 1024\r
-\r
- Y2& = (Y1 * C3& - z1 * S3&) \ 1024\r
- z2 = (Y1 * S3& + z1 * C3&) \ 1024\r
-\r
- z2 = z2 + 300\r
- Xn(R) = 320 + (X2& / z2 * 500)\r
- Yn(R) = 240 + (Y2& / z2 * 500)\r
- Next\r
- \r
-\r
- For a1 = 0 To nl - 1\r
- F1 = pointers1(a1)\r
- S1 = pointers2(a1)\r
-\r
- Xn = Xn(F1)\r
- Yn = Yn(F1)\r
-\r
- X1 = Xn(S1)\r
- Y1 = Yn(S1)\r
-\r
- Line (Xs1(a1), Ys1(a1))-(Xe1(a1), Ye1(a1)), 0\r
- Line (X1, Y1)-(Xn, Yn), 15\r
-\r
-\r
- Xs1(a1) = X1: Ys1(a1) = Y1\r
- Xe1(a1) = Xn: Ye1(a1) = Yn\r
- Next\r
-\r
-\r
- K$ = InKey$\r
- If K$ <> "" Then\r
-\r
- Select Case K$\r
-\r
- Case Chr$(0) + Chr$(72)\r
- d1 = d1 + 1\r
-\r
- Case Chr$(0) + Chr$(80)\r
- d1 = d1 - 1\r
-\r
- Case Chr$(0) + Chr$(75)\r
- d2 = d2 - 1\r
-\r
- Case Chr$(0) + Chr$(77)\r
- d2 = d2 + 1\r
-\r
- Case "w"\r
- d3 = d3 - 1\r
-\r
- Case "z"\r
- d3 = d3 + 1\r
-\r
- Case " "\r
- d1 = d1 / 2\r
- d2 = d2 / 2\r
- d3 = d3 / 2\r
-\r
- Case Chr$(27)\r
- System\r
-\r
- End Select\r
- End If\r
-\r
- Loop\r
-End Sub\r
-\r
+' 3D Wireframe Exclamation mark
+' Author: Svjatoslav Agejenko
+' Use keys:
+' Up, Down, Left, Right, w, z - rotate
+' <space> - speed down
+' q - quit
+
+DECLARE SUB GetCoordinates ()
+DECLARE SUB ScaleCoordinates ()
+DECLARE SUB Render3D ()
+DECLARE SUB CalculateSineCosine ()
+
+DefInt A-Z
+Dim Shared Xn(100), Yn(100), Zn(100)
+Dim Shared Xs1(100), Ys1(100), Xe1(100), Ye1(100)
+Dim Shared x(100), y(100), z(100), pointers1(100), pointers2(100)
+Dim Shared Cosine&(360), Sine&(360)
+Dim Shared numPoints, numLines
+Dim Shared rotationX, rotationY
+rotationX = 0
+rotationY = 0
+
+Screen 12
+Cls
+CalculateSineCosine
+GetCoordinates
+ScaleCoordinates
+Render3D
+
+' Vertex data
+Data 5,-60,-10
+Data 15,-50,-10
+Data 15,0,-10
+Data 5,10,-10
+Data -5,10,-10
+Data -15,0,-10
+Data -15,-50,-10
+Data -5,-60,-10
+Data 5,-60,10
+Data 15,-50,10
+Data 15,0,10
+Data 5,10,10
+Data -5,10,10
+Data -15,0,10
+Data -15,-50,10
+Data -5,-60,10
+Data 5,20,10
+Data 15,30,10
+Data 15,40,10
+Data 5,50,10
+Data -5,50,10
+Data -15,40,10
+Data -15,30,10
+Data -5,20,10
+Data 5,20,-10
+Data 15,30,-10
+Data 15,40,-10
+Data 5,50,-10
+Data -5,50,-10
+Data -15,40,-10
+Data -15,30,-10
+Data -5,20,-10
+Data 999,999,999
+
+' Line data
+Data 0,1
+Data 1,2
+Data 2,3
+Data 3,4
+Data 4,5
+Data 5,6
+Data 6,7
+Data 7,0
+Data 8,9
+Data 9,10
+Data 10,11
+Data 11,12
+Data 12,13
+Data 13,14
+Data 14,15
+Data 15,8
+Data 0,8
+Data 1,9
+Data 2,10
+Data 3,11
+Data 4,12
+Data 5,13
+Data 6,14
+Data 7,15
+Data 16,17
+Data 17,18
+Data 18,19
+Data 19,20
+Data 20,21
+Data 21,22
+Data 22,23
+Data 23,16
+Data 24,25
+Data 25,26
+Data 26,27
+Data 27,28
+Data 28,29
+Data 29,30
+Data 30,31
+Data 31,24
+Data 24,16
+Data 25,17
+Data 26,18
+Data 27,19
+Data 28,20
+Data 29,21
+Data 30,22
+Data 31,23
+Data 999,999
+
+Sub CalculateSineCosine
+ ' Precalculate sine and cosine values for faster computation
+ For angle! = 0 To 359 / 57.29577951# Step 1 / 57.29577951#
+ Cosine&(angle) = Int(.5 + Cos(angle!) * 1024)
+ Sine&(angle) = Int(.5 + Sin(angle!) * 1024)
+ angle = angle + 1
+ Next
+End Sub
+
+Sub GetCoordinates
+ ' Read vertex coordinates from DATA statements
+ For i = 0 To 10000
+ Read x(i), y(i), z(i)
+ If x(i) = 999 Then x(i) = 0: y(i) = 0: z(i) = 0: GoTo EndVertexData
+ Next
+ EndVertexData:
+ numPoints = i
+
+ ' Read line data from DATA statements
+ For i = 0 To 10000
+ Read pointers1(i), pointers2(i)
+ If pointers1(i) = 999 Then GoTo EndLineData
+ Next
+ EndLineData:
+ numLines = i
+End Sub
+
+Sub ScaleCoordinates
+ ' Scale coordinates to fit the screen
+ maxValue = 0
+ For i = 0 To numPoints
+ If Abs(x(i)) > maxValue Then maxValue = Abs(x(i))
+ If Abs(y(i)) > maxValue Then maxValue = Abs(y(i))
+ If Abs(z(i)) > maxValue Then maxValue = Abs(z(i))
+ Next i
+ scaleFactor = 100 / maxValue
+ For i = 0 To numPoints
+ x(i) = x(i) * scaleFactor
+ y(i) = y(i) * scaleFactor
+ z(i) = z(i) * scaleFactor
+ Next i
+End Sub
+
+Sub Render3D
+ Do
+ ' Update rotation angles
+ rotationX = rotationX + dx
+ rotationY = rotationY + dy
+ rotationZ = rotationZ + dz
+ Sound 0, 1
+
+ ' Wrap rotation angles within 0 to 359 degrees
+ If rotationX <= 0 Then rotationX = rotationX + 360
+ If rotationY <= 0 Then rotationY = rotationY + 360
+ If rotationZ <= 0 Then rotationZ = rotationZ + 360
+ If rotationX >= 360 Then rotationX = rotationX - 360
+ If rotationY >= 360 Then rotationY = rotationY - 360
+ If rotationZ >= 360 Then rotationZ = rotationZ - 360
+
+ ' Get sine and cosine values for rotation angles
+ cosX& = Cosine&(rotationX): sinX& = Sine&(rotationX)
+ cosY& = Cosine&(rotationY): sinY& = Sine&(rotationY)
+ cosZ& = Cosine&(rotationZ): sinZ& = Sine&(rotationZ)
+
+ ' Rotate and project vertices
+ For i = 0 To numPoints - 1
+ Xo = x(i): Yo = y(i): Zo = z(i)
+ X1 = (Xo * cosX& - Yo * sinX&) \ 1024
+ Y1 = (Xo * sinX& + Yo * cosX&) \ 1024
+ X2& = (X1 * cosY& - Zo * sinY&) \ 1024
+ Z1 = (X1 * sinY& + Zo * cosY&) \ 1024
+ Y2& = (Y1 * cosZ& - Z1 * sinZ&) \ 1024
+ Z2 = (Y1 * sinZ& + Z1 * cosZ&) \ 1024
+ Z2 = Z2 + 300
+ Xn(i) = 320 + (X2& / Z2 * 500)
+ Yn(i) = 240 + (Y2& / Z2 * 500)
+ Next
+
+ ' Draw lines between vertices
+ For i = 0 To numLines - 1
+ startVertex = pointers1(i)
+ endVertex = pointers2(i)
+ Xn = Xn(startVertex)
+ Yn = Yn(startVertex)
+ X1 = Xn(endVertex)
+ Y1 = Yn(endVertex)
+ Line (Xs1(i), Ys1(i))-(Xe1(i), Ye1(i)), 0
+ Line (X1, Y1)-(Xn, Yn), 15
+ Xs1(i) = X1: Ys1(i) = Y1
+ Xe1(i) = Xn: Ye1(i) = Yn
+ Next
+
+ ' Handle user input
+ K$ = InKey$
+ If K$ <> "" Then
+ Select Case K$
+ Case Chr$(0) + Chr$(72) ' Up arrow
+ dx = dx + 1
+ Case Chr$(0) + Chr$(80) ' Down arrow
+ dx = dx - 1
+ Case Chr$(0) + Chr$(75) ' Left arrow
+ dy = dy - 1
+ Case Chr$(0) + Chr$(77) ' Right arrow
+ dy = dy + 1
+ Case "w"
+ dz = dz - 1
+ Case "z"
+ dz = dz + 1
+ Case " " ' Space bar
+ dx = dx / 2
+ dy = dy / 2
+ dz = dz / 2
+ Case Chr$(27) ' Escape key
+ System
+ End Select
+ End If
+ Loop
+End Sub
\ No newline at end of file
projects / qbasicapps.git / commitdiff